TITLE	FTPSRV -- FILE TRANSFER PROTOCOL SERVER
	SUBTTL	E.A.TAFT/EW13/EAT/DB33/CFE/drp--  may 80 [96bit]

	TWOSEG
	RELOC	400000

	SEARCH	C,TULIP,IMP	;ACCESS GENERAL PARAMETERS AND IMP STUFF

	VERSION	6,,43,6

; note on IO: all IO to the pty is done via the standard OFile.
; IO to the IMP connection is USUALLY done using the Error UUOs
; (EWsix and EDisix).  it you find it nessecary to change the
; the OFile (via "FoSel ImpObl", for example), make sure to change
; the OFile back when you're done, as the rest of the program
; expects it to go to the PTY.


;[96bit] first, define all the site specific things.


;[96bit] the PPn string that must be passed to login to get
;	 the free login for ftp transfers.  leave undefined if
;	 you do not wish to support free logins
Define FtpLogin<SixPPn(70,70)>	;[96bit] avsail uses 70,70

;[96bit] the octal PPn that FtpSrv should ChgPPN to before trying
;	 to login the free subjob for an Ftp transfer.  leave
;	 undefined if you do not wish the current PPN to be changed.
FtpPPn== 70 ,, 70		;[96bit] avsail uses 70,70

;[96bit] now mail information

;[96bit] define the command that should be issued to the monitor to
;	 accomplish a MLFL (Mail File) command.  The input file must
;	 be "Data:".  the line MUST end with number sign ("#") which
;	 produces a <CRLF>, followed by an exclamation mark ("!")
;	 which represents the end of the sixbit string.  Each percent
;	 sign ("%") in the string causes each successive macro
;	 statement to be executed at that point in the printing of
;	 the string.  for more detailed information, read the
;	 tulip modules.
;	 there is no default.  leave this undefined ONLY if you do
;	 not wish to support the MLFL command.
Define MlFlCommand
<
	Disix	[[SIXBIT\Mail %/IDENTI:%/FILE:DATA:#!\]
		PUSHJ	P,IMPPTY
		PUSHJ	P,HSTPRT]
>

;[96bit] define the MAIL command.  all the notes for the MLFL command
;	 apply here as well, except that this command MUST be defined.
Define MailCommand
<
	Disix	[[SIXBIT\Mail %/IDENTI:%/FILE:TTY:#!\]
		PUSHJ	P,IMPPTY
		PUSHJ	P,HSTPRT]
>

;[96bit] the PPN string that should be passed to login to get the
;	 subjob logged in for MLFL transfers.  Leave undefined if
;	 if MLFL transfers should login in the same way as ftp.
;	 (including the ChgPPn used for ftp.)  if defined, the job
;	 is logged out as soon as the transfer is completed.
;[avsail]Define MailLogin<SixPPN(N900AR0M)>	;[96bit] cmu uses Arpanet.Mail

;[96bit] the octal PPN that FtpSrv should ChgPPN to before trying
;	 to login the subjob for an MLFL transfer.  leave undefined
;	 if you do not wish the current PPN to be changed for mail.
;	 (this is ignored if MailLogin is undefined.)
MailPPn== 33125,,13776			;[96bit] cmu avoids a password


;[96bit] Define the logout routine.  leave undefined if
;	 you just want the standard "Kjob/b".
Define KjFunc
<	; CMU, of course, has to do something different.
	WSix	[SIXBIT\KJOB /F#!\];CMU- SAVE ALL FILES
	PUSHJ	P,CPYRSP	;COPY THIS
	TXNN	F,ERRFLG	;ERROR (OVER QUOTA)
	POPJ	P,		;NOPE ALL IS GOODNESS
	PUSHJ	P,CNCUSR	;STOP HIM
	WSix	[SIXBIT\CORE 0#!\];FREE ALL HIS CORE
	PJRST	PTYFLS		;AND GO AWAY
>	;end of KjFunc

;[96bit] End of site specific information


;[96bit] now clean up a little

IfDef	FtpLogin,<	$FtpLog==-1	>
IfDef	MailLogin,<	$MLogin==-1	>
ND	$FtpLog,0
ND	$MLogin,0
ND	FtpPPn,0
ND	MailPPn,0
ND	FtHarv,0	;code for harvard DIRECT
;[96bit]H=	11		;HOST TABLE INDEX FOR LOCAL HOST

;FLAGS USED IN FTPSRV
	FLAG	(OPNFLG)	;TELNET CONNECTION IS OPEN
	FLAG	(LGIFLG)	;SUBJOB IS LOGGED IN
	FLAG	(USRFLG)	;USER NAME GIVEN BUT NOT PASSWORD
	FLAG	(ERRFLG)	;ERROR MESSAGE ENCOUNTERED IN CPYRSP
	FLAG	(SLGFLG)	;FTPSRV IS A LOGGED-IN JOB
	FLAG	(PTYFLG)	;WE HAVE A PTY
	FLAG	(MAILFG)	;WE'RE IN THE MIDDLE OF A MAIL COMMAND
	FLAG	(WRPFLG)	;PTY DIALOGUE RECORDING HAS WRAPPED AROUND
;[96bit]FLAG	(LGAR0M)	;LOGGED IN AS N900AR0M
	FLAG	(TLogin)	;[96bit] should be logged out after
				;  	the command is done.
	FLAG	(MLFLFG)	;WE'RE IN THE MIDDLE OF A MLFL COMMAND
	Flag	(NlsCom)	;[96bit] processing a NLST command

;MISCELLANEOUS PARAMETERS
	PDLSIZ==100		;SIZE OF STACK
	PTY==	1		;I/O CHANNEL FOR PTY
	IMP==	2		;I/O CHANNEL FOR IMP
	ICPSKT==1		;SOCKET FOR LOCAL ICP
	TLNSKT==↑D64		;TELNET SOCKET FOR LOCAL ICP
	CMDLEN==↑D315		;MAXIMUM LEGAL FTP COMMAND LENGTH
;[CFE] Above line reflects the size of MAIL's TTY input buffer,
;[CFE]  namely about 315 characters as of 3-Jan-1981.
	WATWRN==↑D15		;TIME WE'LL WAIT BEFORE WARNING USER
	WATMAX==↑D20		;TIME WE'LL WAIT BEFORE LOGGING HIM OUT
	RECSIZ==↑D50		;NUMBER OF WORDS FOR RECORDING PTY DIALOGUE

;MACRO TO EXECUTE THE IMPUUO.  DONE AS A DEC-STYLE "CALL" SO AS TO
;   BE TRANSPORTABLE TO CMU.

DEFINE IMPUUO(AC,JUNK) <
	MCALL	AC,[SIXBIT\IMPUUO\]
>

;[96bit] Macro to define the control AC for the impuuo
Define ImpAc(Bits,Funct,Block,TimeOut<0>)
    < [ <Bits>!InSVl.(TimeOut,If.Tim)!InSVl.(Funct,If.Fnc)!<Block> ] >

;[96bit] marco to define a sixbit PPN string for the printing routines
Define SixPPn(Proj,Prog),
    < [
	ifnb <Prog>,< Sixbit \'Proj','Prog'!\ >
	ifb <Prog>,< Sixbit \'Proj'!\ >
      ]
    >
	SUBTTL	INITIALIZATION

FTPSRV:	JFCL			;IN CASE CCL ENTRY
	MOVE	P,[IOWD PDLSIZ,PDL] ;SETUP STACK
	START			;DO INITIALIZATION
	SETZM	ZEROL		;CLEAR ZEROED PART OF LOW SEGMENT
	MOVE	T1,[ZEROL,,ZEROL+1]
	BLT	T1,ZEREND-1
	MOVE	T1,[FILLH,,FILLL] ;INITIALIZE LOW SEGMENT DATA
	BLT	T1,FLLEND-1
	GETPPN	T1,		;GET OUR PPN
	  JFCL			;GETPPN SKIPS IF JACCT
	MOVEM	T1,PRJPRG	;REMEMBER IT
;[96bit] we don't care who we are anymore
;[96bit]MOVE	T1,[.IULHS,,LHOSTP] ;RETURN LOCAL HOST PARAMETERS
;[96bit]IMPUUO	T1,
;[96bit]  PUSHJ	P,Idiocy
;[96bit]HRRZ	T1,.IBHST+LHOSTP ;GET LOCAL HOST NUMBER
;[96bit]MOVSI	H,-NHOSTS	;SEARCH HOST TABLE FOR THIS NUMBER
;[96bit]HLRZ	T2,HSTTAB(H)
;[96bit]CAIE	T1,(T2)
;[96bit]AOBJN	H,.-2
;[96bit]JUMPL	H,.+2		;MAKE SURE WE FOUND ONE, AND REMEMBER INDEX
;[96bit]PUSHJ	P,Idiocy

;[96bit]MOVEI	T1,CONBLK	;SEE IF TELNET CONNECTION IS ALREADY OPEN
	Move	T1,ImpAc(If.New,.IuStt,ConBlk)		;[96bit]
	IMPUUO	T1,
	  JRST	NOTELC		;NO, GO TRY TO OPEN ONE

;HERE WITH TELNET CONNECTION OPEN TO USER
TLNOPN:	TXO	F,OPNFLG	;FLAG CONNECTION OPEN
	MOVEI	T1,IMPOBL	;DIRECT ERRORS TO THE TELNET USER
	MOVEM	T1,EFILE##
	Move	T1,.IBHST+CONBLK ;[96bit] DEFAULT HOST IS this one
	Movem	T1,HstTmp	;[96bit] put where it'll get set up
	move	T1,.IBRMT+CONBLK	; get his socket
	MOVEM	T1,RmtSkt		; and remember it for connections
	sos	t1,.IbLcl+ConBlk	; get our socket minus 1
	MOVEM	T1,LclSkt		; that's where connections go
	FSETUP	IMPIBH		;SETUP IMP I/O BLOCKS
	FSETUP	IMPOBH
	FIGET	IMPIBL		;OPEN IMP CONNECTION FOR I/O

;TYPE THE SIGNON MESSAGE
	MOVEI	T1,4		;FIVE WORDS OF MONITOR NAME
CNFGET:	MOVSI	T2,(T1)		;GET A WORD
	HRRI	T2,.GTCNF
	GETTAB	T2,
	  SETZ	T2,		;OOP......
	MOVEM	T2,SYSNAM(T1)	;STORE IT
	SOJGE	T1,CNFGET	;BACK FOR MORE
	MOVSI	T1,'300'	;OK, START WITH SIGNON MESSAGE
	EDisix	[EXP	SRVMSG
		WSIX	4,T1
		WASC	SYSNAM]
;SEARCH FOR A PTY WE CAN HAVE
	FSETUP	PTYIBH		;SETUP PTY FILE BLOCKS
	FSETUP	PTYOBH
	FoSel	PtyOBl		; start off talking naturally to pty.
	MOVX	T1,%CNPTY	;GET FIRST PTY,,# OF PTY'S
	GETTAB	T1,
NOPTAV:	  EDisix [BYEFR1,,[SIXBIT\401 N&O &PTY&S AVAILABLE.  &T&RY AGAIN LATER.#!\]]
	MOVEI	T1,(T1)		;ISOLATE NUMBER OF PTY'S

;HERE WHEN OPEN FAILS ON A PARTICULAR PTY
PTYTRY:	SOJL	T1,NOPTAV	;JUMP IF THERE AREN'T ANY MORE
	MOVEI	T2,(T1)		;GET NEXT PTY NUMBER
	SETZ	T3,		;CONVERT TO OCTAL DIGITS
	LSHC	T2,-3
	LSH	T3,-3
	TXO	T3, <'0'>B5
	JUMPN	T2,.-3
	HLRM	T3,PTYIBL+FILDEV ;STORE IN RIGHT HALF OF PTY NAME
	HLRM	T3,PTYOBL+FILDEV
	FIGET	PTYIBL		;TRY TO ASSIGN IT.  TO PTYTRY IF FAIL
	TXO	F,PTYFLG	;GOT IT -- SET FLAG
;[96bit]HRRZ	T1,HSTADR	;GET FOREIGN HOST'S ADDRESS
;[96bit]PUSHJ	P,HSTNAM##	;FIND OUT WHAT IT'S NAME IS
;[96bit]  SETZ	T1,		;ERROR, PUNT
;[96bit]MOVEM	T1,SXBHST	;STORE THE RESULTS (MAY BE ZERO)
;[96bit]MOVEM	T2,SXBHST+1
;	Pushj	P,SetNam	;[96bit] get the name, if we can.
; don't delay start up to build host tables: put this off until
; we have a command.
	MOVEI	T1,C.BYE	;GO TO BYE ROUTINE TO LOGOUT SUBJOB
	HRRM	T1,.JBREN##	;on a reenter.
	JRST	COMAND		;BEGIN PROCESSING COMMANDS
;HERE WHEN THERE IS NO TELNET CONNECTION OPEN.  IF FTPSRV IS
;   BEING RUN BY A LOGGED-IN USER, ATTEMPT TO DO AN ICP.
NOTELC:	PJOB	T1,		;GET OUR JOB NUMBER
	MOVN	T1,T1		;NEGATE FOR JOBSTS
	JOBSTS	T1,
	  PUSHJ	P,Idiocy		;SHOULDN'T FAIL
	TXNN	T1,JB.ULI	;ARE WE LOGGED IN?
	DISIX	[DOLOGO,,[SIXBIT\?L&OGIN PLEASE#.!\]]
	WSIX	[SIXBIT\P&RIVATE &FTP& SERVER RUNNING.#&M&ONITORING? !\]
	INCHRW	T1		;ASK FOR RESPONSE FROM TTY
	CAIN	T1,CR		;IF CARRIAGE RETURN
	INCHRW	T1		;  ABSORB LINE FEED
	CAIE	T1,"Y"		;YES IN EITHER UPPER OR LOWER CASE?
	CAIN	T1,"Y"+40
	TXO	F,SLGFLG	;YES, REMEMBER SERVER LOGGED-IN AND MONITORING
	pjob	t1,			; get job again
	LSH	T1,9
	ADDI	T1,ICPSKT	;BUILD LOCAL ICP SOCKET NUMBER
	DISIX	[[SIXBIT\#A&WAITING &ICP& ON SOCKET %#!\]
		WDEC	T1]
;[96bit]MOVE	T1,[7B10+<.IUREQ>B17+ICPCON] ;WAIT FOR ICP REQUEST
	Move	T1,ImpAc(If.New,.IuReq,ConBlk,7)	;[96bit]
	IMPUUO	T1,
	  JRST	ICPERR		;ERROR (MAYBE TIMED OUT)

repeat 0,<	;[tcp] old complex stuff not needed anymore.
;[96bit]HRLI	T1,.IUCON	;OK, CONNECT
	HRLI	T1,.IUCON(If.New)	;[96bit] OK, CONNECT
	IMPUUO	T1,
	  JRST	ICPERR
	MOVE	T1,.IBRMT+ICPCON ;GET HIS SOCKET (INPUT)
	ADDI	T1,3		;STORE HIS CORRECT TELNET OUTPUT SOCKET
	MOVEM	T1,.IBRMT+CONBLK
	MOVE	T1,.IBHST+ICPCON ;GET HOST NUMBER
;[96bit]HRRM	T1,.IBHST+CONBLK ;STORE IN TELNET CONNECTION BLOCK
	Movem	T1,.IBHST+CONBLK ;[96bit] STORE IN TELNET CONNECTION BLOCK
;[96bit]MOVE	T1,[.IULSN,,CONBLK] ;SET TELNET SOCKETS INTO LISTEN STATE
	Move	T1,ImpAc(If.New,.IuLsn,ConBlk)		;[96bit]
	IMPUUO	T1,
	  JRST	ICPERR
	SOS	.IBRMT+CONBLK
	AOS	.IBLCL+CONBLK
	IMPUUO	T1,
	  JRST	ICPERR
	FSETUP	ICPBLH		;OPEN ICP SOCKET FOR OUTPUT
	FOOPEN	ICPBLK
	HRRZ	T1,PRJPRG	;COMPUTE OUR FULL LOCAL SOCKET NUMBER
	LSH	T1,9
	IORI	T1,TLNSKT	;  FOR THE SERVER TELNET CONNECTION
	MOVE	T2,[POINT 8,T1,3] ;UNPACK 8 BITS AT A TIME
	ILDB	T3,T2
	WCHI	(T3)		;STUFF AN 8-BIT BYTE
	TXNE	T2,77B5		;DONE?
	JRST	.-3		;NO, DO MORE
	FOCLOS	ICPBLK		;YES, SEND ICP DATA ON ITS WAY
;[96bit]MOVE	T1,[.IUCLS,,ICPCON] ;  BY CLOSING THE ICP SOCKET
	Move	T1,ImpAc(If.New,.IuCls,ICPCon)		;[96bit]
	IMPUUO	T1,
	  JRST	ICPERR
repeat 0 continues to next page
;CONTINUATION OF ICP CODE and repeat 0

	SETZM	OFILE##		;OUTPUT BACK TO TTY
;[96bit]MOVE	T1,[IF.NWT+<.IUCON>B17+CONBLK] ;CONNECT THE TELNET SOCKETS
	Move	T1,ImpAc(If.Nwt!If.New,.IuCon,ConBlk)	;[96bit]
	IMPUUO	T1,		;DO THE OUTPUT SOCKET FIRST
	  JRST	ICPERR
	AOS	.IBRMT+CONBLK	;NOW THE INPUT SOCKET
	SOS	.IBLCL+CONBLK
;[96bit]HRLI	T1,.IUCON	;WAIT FOR THIS ONE
	HRLI	T1,.IUCON(If.New)	;[96bit] WAIT FOR THIS ONE
	IMPUUO	T1,
	  JRST	ICPERR
	SOS	.IBRMT+CONBLK	;NOW BACK TO LOOK AT THE OUTPUT SIDE
	AOS	.IBLCL+CONBLK
	IMPUUO	T1,		;WAIT FOR SOCKET TO BECOME OPEN
	  JFCL			;PROBABLY ALREADY WAS OPEN
> ;[tcp] end of repeat 0

;[96bit]MOVEI	T1,CONBLK	;GET ITS STATUS
	Move	T1,ImpAc(If.New,.IuStt,ConBlk)		;[96bit]
	IMPUUO	T1,
	  JRST	ICPERR
	LDB	T2,[POINT 6,.IBSTT+CONBLK,35] ;OUTPUT SIDE OPEN NOW?
	CAIN	T2,.ISEst		; established?
	  DISIX	[TLNOPN,,[SIXBIT\ICP &COMPLETED.#!\]]


;HERE WHEN SOMETHING FAILS DURING THE ICP.
ICPERR:	SETZM	OFILE##		;MAKE OUTPUT COME OUT ON THE TTY
	WSIX	[SIXBIT\? S&ERVER &T&ELNET &ICP& FAILED#!\]
;[96bit]MOVE	T1,[IF.NWT+<.IUCLS>B17+ICPBLK] ;CLOSE ICP BLOCK IN CASE OPEN
	Move	T1,ImpAc(If.Nwt!If.New,.IuCls,ICPBlk)	;[96bit]
	IMPUUO	T1,
	  JFCL
	JSP	T4,BYEFRC	;CLOSE CONNECTIONS IF OPEN
	SUBTTL	COMMAND TABLES

;BITS IN LH OF COMMAND DISPATCH ENTRY
	CM.LGI==1B0		;LOGIN REQUIRED FOR THIS COMMAND
	CM.HLP==1B1		;LIST COMMAND IN THE HELP MESSAGE
	CM.LGM==1B2		;[96bit] use mlfl login, and logout
				;	 the job when the transfer's
				;	 done.


DEFINE COMS <

	CC	USER,<HLP>
	CC	PASS,<HLP>
	CC	ACCT,<>
	CC	BYTE,<HLP>
	CC	SOCK,<HLP>
	CC	Pasv,<>		; give "not implemented" for this
	CC	TYPE,<HLP>
	CC	STRU,<HLP>
	CC	MODE,<HLP>
	CC	RETR,<LGI,HLP>
	CC	STOR,<LGI,HLP>
	CC	APPE,<>
	CC	RNFR,<LGI,HLP>
	CC	RNTO,<LGI,HLP>
	CC	DELE,<LGI,HLP>
	CC	LIST,<LGI,HLP>
	CC	NLst,<LGI,HLP>	;[96bit] implement name-list
	CC	ALLO,<>
	CC	REST,<>
	CC	STAT,<HLP>
	CC	ABOR,<>
	CC	BYE ,<HLP>
Ife $MLogin,<	;[96bit] MLFL doesn't need to logout
	CC	MLFL,<LGI,HLP>
>; ife $MLogin
ifn $MLogin,<	;[96bit] MLFL needs to logout
	CC	MLFL,<LGI,LGM,HLP>
>; ifn $MLogin
	CC	MAIL,<HLP>
	CC	HELP,<>
	CC	NoOp,<>		;[96bit] implement NoOp
	CC	XCWD,<LGI,HLP>
	CC	XSRC,<LGI,HLP>
	CC	XTIM,<HLP>
	CC	XREP,<>

>
;ASSEMBLE COMMAND NAMES

DEFINE CC(A,B) <
	<SIXBIT	\A\>
>

	XALL

COMTAB:	COMS

	COMLEN==.-COMTAB	;NUMBER OF COMMANDS IN TABLE
;ASSEMBLE COMMAND DISPATCH TABLE

DEFINE CC(A,B) <
	ZZ==	0
IFNB<B>,<IRP B<
	ZZ==	ZZ+CM.'B
>>
IFDEF C.'A,<
	ZZ +	C.'A
>
IFNDEF C.'A,<
	ZZ +	COMUNI
>>

COMDSP:	COMS

	SALL
	SUBTTL	FTP COMMAND DECODING AND DISPATCH

;HERE WHEN FTPSRV HAS NOTHING BETTER TO DO.  WAIT FOR INPUT FROM
;   EITHER THE IMP OR THE PTY.
COMAND:	PUSHJ	P,IMPCHK	;MAKE SURE TELNET CONNECTION IS STILL OPEN
;[tcp] there's nothing special about FTPSRV IMPs, they are just connected
;[tcp]	to TTYs, and the TTY is what we talk to.  IO.DAT cannot be on for
;[tcp]	a non-imp.
;[tcp]	STATZ	IMP,IO.DAT	;  OR MORE AVAILABLE FROM TELNET CONNECTION?
	skpinl				;[tcp] another command?
	 SKIPle	IMPIBL+FILCTR		;[tcp] perhaps read in already?
	  JRST	IMPGET		;YES, PROCESS IT
	PUSHJ	P,PTYCHK	;NO, HAS ANYTHING COME FROM THE PTY?
	  AOSA	T1,WATCNT	;NO, INCREMENT TIME WE'VE BEEN WAITING
	JRST	PTYGET		;YES, PROCESS IT
	CAIN	T1,WATWRN*↑D60	;TIME TO WARN OUR INACTIVE USER?
	EDisix	[[SIXBIT\030 Y&OU WILL BE LOGGED OFF IN % MINUTES IF YOU CONTINUE TO DO NOTHING.#!\]
		WDECI	WATMAX-WATWRN]
	CAIN	T1,WATMAX*↑D60	;TIME TO GIVE UP ON HIM?
	EDisix	[C.BYE,,[SIXBIT\430 I&NACTIVITY TIMEOUT--GOODBYE.#!\]]
	MOVEI	T1,1		;SLEEP FOR A SECOND
	SLEEP	T1,
	JRST	COMAND		;GO LOOK AGAIN


;HERE WHEN SOMETHING COMES BACK FROM THE PTY.  JUST COPY IT TO THE IMP.
PTYGET:	MOVSI	T1,'050'	;MISC MESSAGE CODE
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO IMP
	JRST	COMAND		;RESUME WAITING
;HERE WHEN A MESSAGE ARRIVES FROM THE IMP.  FIRST, READ THE ENTIRE
;  LINE INTO CORE AND CHECK FOR ILLEGAL CHARACTERS AND IMPROPER TERMINATION.
IMPGET:	HLLZS	WATCNT		;RESET WAIT COUNT
;[CFE]	Clear out CmdBuf before storing into it.  Remember count of
;[CFE]	  characters stored, also; use count reading from buffer.
	setzm	CmdBuf		;[CFE] Clear first word,
	move	t1,[xwd CmdBuf,CmdBuf+1]
	blt	t1,CmdBuf+<CmdLen/5>	;[CFE]  clear the rest.
	MOVE	T1,[POINT 7,CMDBUF] ;POINT TO COMMAND STORAGE BUFFER
	MOVEM	T1,CMDPTR	;STORE FOR LATER USE
	MOVEI	T2,CMDLEN	;MAX LEGAL COMMAND LENGTH
	FISEL	IMPIBL		;INPUT FROM IMP
; IMP output uses Error UUOs.
;	FOSEL	IMPOBL		;OUTPUT POSSIBLE MESSAGES TO IMP

;MAKE SURE THIS IS A REAL MESSAGE COMING AND NOT JUST SOME LEFTOVER NULLS
IMPGE4:	RCHF	P1		;GET A CHAR FROM THE IMP
	JUMPN	P1,IMPGE1	;A REAL CHAR, PROCESS IT
;[tcp]	SKIPG	IMPIBL+FILCTR	;NO, ANY MORE INPUT DATA?
;[tcp]	STATZ	IMP,IO.DAT	;NO, MORE TO GET FROM THE IMP?
;[tcp]	JRST	IMPGE4		;YES, DO IT
	JRST	COMAND		;NO, FORGET IT

;[CFE, 3-Jan-81] If this is MAIL command input, artificially insert
;[CFE] CRLFs to break very-long lines to lengths that MAIL will
;[CFE] handle for us.
IMPGE5:	txnn	F,MAILFG	; Are we doing a MAIL?
	  jrst	IMPGE0		;  Yes: don't test here.
IMPGE7:	caig	T2,2		; More than two spaces left?
	  jrst	IMPGE6		;  No; force a CRLF.
	caig	T2,↑D15		; 15 or fewer spaces left
	 caie	P1," "		;  and this char is a space ( =40 )?
	  jrst	IMPGE0		; No, it's OK: treat ordinarily.
IMPGE6:	movei	P1,15		; Force a CRLF into cmd buffer.
	idpb	P1,T1
	movei	P1,12
	idpb	P1,T1
	subi	T2,2		; Account for spaces used.
	EWSix	[sixbit\051 L&ong &MAIL& line broken into pieces.#!\]
	jrst	CmdFin		; Send buffered text to MAIL subjob.
;[CFE] end of long-line patch

IMPGE0:	RCHF	P1		;GET A CHAR FROM THE IMP
	JUMPE	P1,IMPGE0	;IGNORE NULLS
IMPGE1:	TXNN	F,MAILFG	;MAIL MODE?
	JRST	IMPGE3		;NO, DON'T THROW OUT SPECIAL CHARS
	CAIE	P1,"C"&37	;↑C?
	CAIN	P1,"Z"&37	;OR ↑Z?
	JRST	IMPGE0		;IGNORE SINCE THEY'LL TERMINATE MAIL
;[CFE]	CAIE	P1,33		;CHECK FOR ALL ALTMODES
;[CFE]	CAIL	P1,175		;DON'T WORRY ABOUT LOSING RUBOUTS
	cain	P1,33		;[CFE] Check MAIL's <escape> terminator
	JRST	IMPGE0		;IGNORE...SAME REASON
IMPGE3:	IDPB	P1,T1		;PACK CHARACTER INTO COMMAND BUFFER
	SOJGE	T2,IMPGE2	;COUNT THE CHARACTER
	; more than we can take: load error and go die.
	Movei	T1,[SIXBIT\500 L&AST LINE WAS TOO LONG.#!\]
	JRST	CMDERR
IMPGE2:	TXNE	P2,LETTER!LGLSIX ;LEGAL CHARACTER?
;[CFE]	JRST	IMPGE0		;YES, GO ON TO NEXT
	  jrst	IMPGE5		;[CFE] Check MAIL lines, then go on.
	CAIN	P1,LF		;LINE FEED?
	JRST	CMDFIN		;YES, END OF COMMAND
	TXNE	F,MAILFG	;IN MAIL MODE?
;[CFE]	JRST	IMPGE0		;YES, STORE CHAR WITHOUT FURTHER ADO
	  JRST	IMPGE7		;[CFE] YES, STORE CHAR after size check
	CAIN	P1,CR		;CARRIAGE RETURN?
	RCHF	P1		;YES, GET NEXT
	JUMPE	P1,.-1		;IGNORE NULLS
	CAIN	P1,LF		;IS NEXT LINE FEED?
	JRST	IMPGE1		;YES, FINISH OFF THE LINE
	Movei	T1,[SIXBIT\500 L&AST LINE WAS UNRECOGNIZABLE.#!\]

;HERE WHEN THE COMMAND IS IN ERROR.  error message in T1.
CMDERR:	CAIN	P1,LF		;LINE FEED?
	JRST	CMDER1		;YES
	RCHF	P1		;NO, DISCARD AND GET NEXT
	JRST	CMDERR
CMDER1:	EWSix	(T1)		; send the error message
	JRST	COMAND		;WAIT FOR NEXT COMMAND
;HERE WHEN A COMPLETE COMMAND HAS BEEN INPUT.  DECIPHER IT
CMDFIN:				;THE MAIL FUNCTION ACCEPTS DATA OVER THE
				;TELNET CONNECTION, SO WE HAVE TO CHECK IT
;[CFE]	Set up character count first.
	subi	t2,CmdLen	;[CFE] Get negative character count
	movnm	t2,CmdCnt	;[CFE]  and store for RCHICB.
	TXNN	F,MAILFG	;IN MAIL MODE?
	JRST	CMDIS		;NO, A COMMAND IT IS
	PUSHJ	P,C.MAIX	;HANDLE THIS LINE
	JRST	COMAND		;AND TRY THE NEXT
CMDIS:	FSETUP	IMPCBH		;SETUP IMP INPUT PSEUDO-FILE
	FISEL	IMPCBL		;SELECT IT
	MOVE	T1,[POINT 6,T2]	;PREPARE TO PACK COMMAND NAME
	SETZ	T2,
CMDFN1:	RCHF	P1		;GET A CHAR
	TXNN	P2,LETTER	;IS IT A LETTER?
	JRST	CMDSRC		;NO, END OF COMMAND
	SUBI	P1,40		;CONVERT TO SIXBIT
	TXNE	T1,77B5		;IS THERE ROOM FOR MORE LETTERS?
	IDPB	P1,T1		;YES, STORE IT
	JRST	CMDFN1		;BACK FOR MORE

;HERE WHEN END OF COMMAND NAME REACHED
CMDSRC:	JUMPN	T2,CMDSR1	;JUMP IF NONBLANK
	EWSix	[SIXBIT\500 L&AST LINE WAS UNRECOGNIZABLE.#!\]
	JRST	COMAND		;WAIT FOR NEXT COMMAND
CMDSR1:	CAIE	P1," "		;WAS THE CHAR A SPACE?
	LCHF	P1		;NO, BACK UP OVER IT
	MOVEM	T2,CMDNAM	;REMEMBER COMMAND NAME
	MOVSI	T1,-COMLEN	;NUMBER OF COMMANDS
	CAME	T2,COMTAB(T1)	;SEARCH FOR COMMAND NAME
	AOBJN	T1,.-1
	JUMPGE	T1,CMDNFD	;JUMP IF NOT IN TABLE
	MOVE	P4,COMDSP(T1)	;GET CORRESPONDING DISPATCH ENTRY
	TXNE	P4,CM.LGI	;LOGIN REQUIRED?
	TXNE	F,LGIFLG	;YES, IS SUBJOB LOGGED IN?
	JRST	.+3		;YES, OR NOT REQUIRED
	PUSHJ	P,FRELGI	;NO, ATTEMPT A FREE LOGIN
	  JRST	COMAND		;UNSUCCESSFUL (MSG ALREADY PRINTED)
	Call	SetNam		;[96bit] make sure have set host up.
	PUSHJ	P,(P4)		;DO COMMAND PROCESSING
	JRST	COMAND		;WAIT FOR NEXT COMMAND


;HERE WHEN COMMAND NAME NOT FOUND
CMDNFD:	EDisix	[COMAND,,[SIXBIT\500 % &COMMAND NOT RECOGNIZED.#!\]
		WNAME	CMDNAM]

;HERE WHEN COMMAND IS NOT IMPLEMENTED
COMUNI:	EDisix	[COMAND,,[SIXBIT\506 % &COMMAND NOT IMPLEMENTED.#!\]
		WNAME	CMDNAM]
	SUBTTL	SYSTEM ACCESS COMMANDS

;   USER <USER NAME>

C.USER:	TXZE	F,LGIFLG	;IS USER ALREADY LOGGED IN?
	PUSHJ	P,LGOUSR	;YES, LOG HIM OUT FIRST
	TXOE	F,USRFLG	;USER NAME ALREADY GIVEN?
	PUSHJ	P,CNCUSR	;YES, FORCE SUBJOB TO MONITOR LEVEL
	Disix	[[SIXBIT\LOGIN %#!\] ;SEND LOGIN COMMAND TO SUBJOB
		PUSHJ	P,IMPPTY]
	PUSHJ	P,CHKLGI	;GO TAKE A LOOK AT HOW WE DID
	  PJRST	LGIERR		;DROPPED ON OUR NOSE. TELL USER
	  EDisix [PTYFLS,,[SIXBIT\330 P&ASSWORD, PLEASE.#!\]]
	PJRST	LGIFIN		;NO PSW NEEDED, WELCOME HIM
;   PASS <PASSWORD>

C.PASS:	TXNN	F,USRFLG	;GIVEN USER NAME YET?
	EDisix	[CPOPJ##,,[SIXBIT\504 USER &COMMAND MUST PRECEDE PASSWORD.#!\]]
	PUSHJ	P,IMPPTY	;OK, COPY PASSWORD TO LOGIN
	W2CHI	CRLF		;TERMINATE IT
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	LGIERR		;ERROR
	PUSHJ	P,PTYF1L	;FLUSH LINE OF ASTERISKS
	PUSHJ	P,GETRSP	;CHECK RESPONSE ON NEXT LINE
	  PJRST	LGIERR		;ERROR

;HERE WHEN LOGIN OPERATION FINISHED
LGIFIN:	TXC	F,USRFLG!LGIFLG ;CLEAR USRFLG, SET LGIFLG
	PUSHJ	P,SJBPPN	;FIND OUT THE PPN OF OUR SUBJOB
	MOVEM	T1,PRJPRG	;SAVE FOR LATER USE
	MOVSI	T1,'050'	;COPY RESPONSE TO USER AS SYSTEM INFO
	LCHF	P1		;DON'T MISS FIRST CHAR OF RESPONSE
	PUSHJ	P,CPYRSP
	EWSix	[SIXBIT\230 L&OGIN SUCCESSFUL.#!\]
	POPJ	P,



;   ACCT <ACCOUNT STRING>

C.ACCT:	EWSix	[SIXBIT\200 A&CCOUNTS NOT USED ON THIS SYSTEM.#!\]
	POPJ	P,
;   BYE

C.BYE:	move	p,[iowd PdlSiz,Pdl] ;RESET THE STACK
	txne	f,PtyFlg	;DO WE HAVE A PTY?
	  pushj	p,FreOut	;LOG possible SUBJOB OFF
	EWSix	[SIXBIT\231 B&YE.#!\] ;TRY TO BE FRIENDLY
	Releas	Pty,
	txz	f,PtyFlg	;REMEMBER WE DON'T HAVE A PTY ANY MORE
	jsp	t4,ByeFrc	; Remember how we got here

;HERE TO FORCE BYE COMMAND WHEN WE KNOW THE SUBJOB ISN'T LOGGED IN
BYEFRC:
;[CFE] First, see if the Imp connection is open; don't hang trying
;[CFE]  to send to an absent connection!  Note: this doesn't eliminate
;[CFE]  race conditions between remote-close and this RELEASE, but it
;[CFE]  does narrow the race window.
	pushj	p,ImpChk	;[CFE] One final test.  Will terminate.
	movei	t1,Imp		;[CFE] This is channel to reset, maybe.
	txnn	f,OpnFlg	;[CFE] Is conn still open?
	 ResDv.	t1,		;[CFE]  No; flush the device buffers.
	  jfcl			;[CFE] (ok, we were just trying...)
	pushj	p,ImpChk	;[CFE] Test again.
	RELEASE	IMP,		;FORCE OUT ANY PENDING MESSAGES
;[96bit]MOVE	T1,[IF.NWT+<.IUCLS>B17+CONBLK] ;CLOSE TELNET CONNECTIONS
	Move	T1,ImpAc(If.Nwt!If.New,.IuCls,ConBlk)	;[96bit]
	SETZM	CONBLK+.IBLCL	;INPUT SIDE
	IMPUUO	T1,		;NO WAIT FOR ACTION
	  JFCL
;[tcp]	AOS	CONBLK+.IBLCL	;NOW OUTPUT SIDE
;[tcp]	IMPUUO	T1,
;[tcp]	  JFCL
DOLOGO:	LOGOUT			;GO AWAY.

; Dummy BYEFRC callers for tracing where the hanging comes from.
BYEFR1:	jsp	t4,ByeFrc	; Remember PC
BYEFR2:	jsp	t4,ByeFrc
BYEFR3:	jsp	t4,ByeFrc


FREOUT:
	TXZE	F,USRFLG!MAILFG ;IF IN LOGIN OR MAIL...
	PUSHJ	P,CNCUSR	;FORCE SUBJOB TO COMMAND LEVEL
	TXZE	F,LGIFLG	;IS SUBJOB LOGGED IN?
	PUSHJ	P,LGOUSR	;YES, LOG IT OUT
	pjrst	PTYFLS		;MAKE SURE ALL OUTPUT IS ABSORBED
	SUBTTL	DATA TRANSFER PARAMETER COMMANDS

repeat 0,<	; no byte size in TCP

;   BYTE <BYTE SIZE>

C.BYTE:	PUSHJ	P,GETDEC	;GET BYTE SIZE
	  JRST	BYTERR		;ERROR IN NUMBER
	CAIE	P1,LF		;END OF LINE?
BYTERR:	EDisix	[CPOPJ##,,[SIXBIT\501 B&YTE SIZE SPECIFICATION ERROR.#!\]]
	CAIL	T1,1		;CHECK BYTE SIZE FOR LEGALITY
	CAILE	T1,↑D255
	JRST	BYTERR		;OUT OF RANGE
	CAIE	T1,↑D8		;CHECK FOR BYTE SIZES THAT OUR
	CAIN	T1,↑D36		;  CRUMMY IMPSER CAN HANDLE PROPERLY
	CAIA			;OK
	EDisix	[CPOPJ##,,[SIXBIT\506 B&YTE SIZE % NOT SUPPORTED.#!\]
		WDECI	(T1)]
	MOVEM	T1,BYTSIZ	;OK, STORE BYTE SIZE
	EDisix	[CPOPJ##,,[SIXBIT\200 B&YTE SIZE % ACCEPTED.#!\]
		WDECI	(T1)]

> ; end of repeat 0
;   SOCK <SOCKET>      OR     SOCK <HOST>,<SOCKET>

C.SOCK:	PUSHJ	P,GETDEC	;GET DECIMAL NUMBER
	  JRST	SKTERR		;ERROR
	Caie	P1,"."		;[96bit] <Host>.<Site>?
	 Cain	P1,"/"		;[96bit] or <Host>/<Site>?
	  Jrst	[		;[96bit] one of them: must be host.
		 Move	T2,T1		;[96bit] save host number
		 Pushj	p,GetDec	;[96bit] get the site number
		   Jrst	SockBH		;[96bit] no site: bad format
		 Caie	P1,","		;[96bit] now a socket?
		   Jrst	SktErr		;[96bit] no: not legal.
		 Jrst	Sockt3		;[96bit] ok: go juggle right
		]
	;[96bit] just a straight host or socket number.
	CAIE	P1,","		;COMMA?
	JRST	SOCKT1		;NO, NOT CHANGING HOST
;[96bit]CAIL	T1,1		;YES, CHECK FOR LEGAL HOST NUMBER
	CAILE	T1,↑D255	; does it look like in old format?
	  Jrst	Sockt2		;[96bit] full host: just check and store
	;[96bit] old format: convert to proper format
	LDB	T2,[Point 2,T1,35-6]	;[96bit] host number
	Andi	T1,77			;[96bit] mask out host number
Sockt3:	Dpb	T2,[Pointr (T1,Ih.Hst)]	;[96bit] host in place

Sockt2:	Txnn	T1,Ih.Imp	;[96bit] is there a site?
	  Jrst	SockBH		;[96bit] no: illegal host
	Movem	T1,HstTmp	;[96bit] save the host number
	PUSHJ	P,GETDEC	;GET SOCKET NUMBER
	  JRST	SKTERR		;ERROR
SOCKT1:	CAIN	P1,LF		;CHECK FOR LEGAL FORMAT
	TLNE	T1,(-1←↑D32)	;AND FOR LEGAL SOCKET NUMBER
	  Jrst	SktErr		; out of range
	MOVE	T2,T1		;OK, COPY SOCKET NUMBER
	ANDCAI	T2,1		;HIS INPUT IS OUR OUTPUT, SO COMPLEMENT
	MOVEM	T1,RmtSkt	;STORE NEW REMOTE INPUT OR OUTPUT SOCKET
	Call	SetNam		;[96bit] store HstTmp, and get new name.
				;	 (saves T1 & T2)
	EDisix	[CPOPJ##,,[SIXBIT\200 S&OCKET % AT HOST % (%) ACCEPTED.#!\]
		WDEC	T1
;[96bit]	WDEC	HSTADR
		Call	HstPrt	;[96bit] print host name
		Call	HstNoo	;[96bit] and print number, to make
				;	 clear how we interpreted
		]
SockBH:	EDisix	[CPOPJ##,,[SIXBIT\501 H&OST NUMBER SPECIFICATION ERROR.#!\]]
SKTERR:	Clearm	HstTmp		;[96bit] clear potential new host adr
	EWSix	[SIXBIT\501 S&OCKET NUMBER SPECIFICATION ERROR.#!\]
	Return
repeat 0,<	; con't handle odd types

;   TYPE <TYPE CODE>

C.TYPE:	PUSHJ	P,SPNOR		;IGNORE SPACES
	MOVSI	T1,-TYPLEN	;PREPARE TO SEARCH TYPE TABLE
	HLRZ	T2,TYPCOD(T1)	;GET TYPE CODE
	CAIE	T2,(P1)		;IS THIS IT?
	AOBJN	T1,.-2		;NO, TRY NEXT
	JUMPGE	T1,.+3		;JUMP IF NOT FOUND
	PUSHJ	P,SPNOR1	;OK, CHECK FOR LEGAL FORMAT
	CAIE	P1,LF
	EDisix	[CPOPJ##,,[SIXBIT\501 D&ATA TYPE SPECIFICATION ERROR.#!\]]
	MOVE	T1,TYPCOD(T1)	;FETCH TYPE DESCRIPTOR
	TRNE	T1,400000	;IMPLEMENTED?
	EDisix	[CPOPJ##,,[SIXBIT\506 T&YPE % NOT IMPLEMENTED.#!\]
		WCHI	(T2)]	;NO
	MOVEM	T1,XFRTYP	;YES, STORE NEW TYPE DESCRIPTOR
	EDisix	[CPOPJ##,,[SIXBIT\200 T&YPE % ACCEPTED.#!\]
		WCHI	(T2)]


;TYPE TABLE
TYPCOD:	"A" ,,	0		;ASCII
	"I" ,,	1		;IMAGE
	"L" ,,	-1		;LOCAL BYTE (NOT IMPLEMENTED)
	"P" ,,	-1		;PRINT FILE (NOT IMPLEMENTED)
	"E" ,,	-1		;EBCDIC PRINT FILE (NOT IMPLEMENTED)

	TYPLEN==.-TYPCOD	;NUMBER OF DIFFERENT KNOWN TYPE CODES

> ; end of repeat 0
repeat 0,<	; not implemented in TCP

;   STRU <STRUCTURE CODE>

C.STRU:	PUSHJ	P,SPNOR		;IGNORE SPACES
	MOVSI	T1,-STRLEN	;PREPARE TO SEARCH STRUCTURE TABLE
	HLRZ	T2,STRCOD(T1)	;GET AN ENTRY
	CAIE	T2,(P1)		;IS THIS IT?
	AOBJN	T1,.-2		;NO
	JUMPGE	T1,.+3		;JUMP IF NOT FOUND
	PUSHJ	P,SPNOR1	;CHECK SYNTAX
	CAIE	P1,LF		;DID EOL IMMEDIATELY FOLLOW?
	EDisix	[CPOPJ##,,[SIXBIT\501 S&TRUCTURE SPECIFICATION ERROR.#!\]]
	MOVE	T1,STRCOD(T1)	;OK, GET SPECIFIER WORD
	TRNE	T1,400000	;IS IT IMPLEMENTED?
	EDisix	[CPOPJ##,,[SIXBIT\506 S&TRUCTURE % NOT IMPLEMENTED.#!\]
		WCHI	(T2)]
	MOVEM	T1,STRTYP	;OK, STORE STRUCTURE SPECIFIER
	EDisix	[CPOPJ##,,[SIXBIT\200 S&TRUCTURE % ACCEPTED.#!\]
		WCHI	(T2)]


STRCOD:	"F" ,,	0		;FILE (NO RECORD STRUCTURES)
	"R" ,,	-1		;RECORD (NOT IMPLEMENTED)

	STRLEN==.-STRCOD

> ; end of repeat 0
repeat 0,<	; not implemented in this TCP hack

;   MODE <MODE CODE>

C.MODE:	PUSHJ	P,SPNOR		;IGNORE SPACES
	MOVSI	T1,-MODLEN	;SEARCH MODE TABLE
	HLRZ	T2,MODCOD(T1)
	CAIE	T2,(P1)		;IS THIS IT?
	AOBJN	T1,.-2		;NO, TRY NEXT
	JUMPGE	T1,.+3		;JUMP IF NOT FOUDN
	PUSHJ	P,SPNOR1	;CHECK FOR LEGAL SYNTAX
	CAIE	P1,LF
	EDisix	[CPOPJ##,,[SIXBIT\501 M&ODE SPECIFICATION ERROR.#!\]]
	MOVE	T1,MODCOD(T1)	;OK, FETCH MODE SPECIFIER
	TRNE	T1,400000	;IMPLEMENTED?
	EDisix	[CPOPJ##,,[SIXBIT\506 M&ODE % NOT IMPLEMENTED.#!\]
		WCHI	(T2)]
	MOVEM	T1,MODTYP	;OK, SAVE MODE SPECIFIER
	EDisix	[CPOPJ##,,[SIXBIT\200 M&ODE % ACCEPTED.#!\]
		WCHI	(T2)]


MODCOD:	"S" ,,	0		;STREAM
	"B" ,,	-1		;BLOCK (NOT IMPLEMENTED)
	"T" ,,	-1		;TEXT (NOT IMPLEMENTED)
	"H" ,,	-1		;HASP (NOT IMPLEMENTED)

	MODLEN==.-MODCOD

> ; end of repeat 0
	SUBTTL	FTP DATA TRANSFER FUNCTIONS

;   RETR <PATHNAME>

C.RETR:	MOVE	T1,[SIXBIT\DATA\] ;LOGICAL NAME FOR IMP DEVICE
	HRRZ	T2,XFRTYP	;DATA TYPE FOR TRANSFER
	PUSHJ	P,DoOpen	;OPEN SUBJOB'S IMP OUTPUT CONNECTION
	  POPJ	P,		;ERROR--MESSAGE ALREADY PRINTED
	WSix	[SIXBIT\R PIP#!\] ;START SUBJOB RUNNING PIP
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  JRST	XFRERR		;ERROR??
	HRRZ	T1,XFRTYP	;GET TRANSFER TYPE
	Disix	[[SIXBIT\DATA: = %#!\] ;ENTER PIP COMMAND
		PUSHJ	P,IMPPTY]
RtrEnd:	;[96bit] end a RETR or LIST
	PUSHJ	P,XFRCHK	;CHECK FOR SUCCESSFUL COMPLETION
	  POPJ	P,		;ERROR, MESSAGE ALREADY PRINTED
	PUSHJ	P,CNCUSR	;FORCE SUBJOB TO COMMAND LEVEL
	WSix	[SIXBIT\IMP CLOSE DATA:#!\] ;CLOSE DATA CONNECTION
	MOVSI	T1,'452'	;CODE TO USE IF ERROR
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR--COPY MESSAGE TO USE4R AND QUIT
	EWSix	[SIXBIT\252 T&RANSFER COMPLETED.#!\]
	PJRST	PTYFLS		;FLUSH PTY OUTPUT AND RETURN
;   STOR <PATHNAME>

C.STOR:	MOVE	T1,[SIXBIT\DATA\] ;LOGICAL NAME FOR IMP DEVICE
	HRRZ	T2,XFRTYP	;DATA TYPE FOR TRANSFER
	PUSHJ	P,DoOpen	;OPEN SUBJOB'S IMP INPUT CONNECTION
	  POPJ	P,		;ERROR--MESSAGE ALREADY PRINTED
	WSix	[SIXBIT\R PIP#!\] ;START SUBJOB RUNNING PIP
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  JRST	XFRERR		;COULDN'T START PIP
	HRRZ	T1,XFRTYP	;FETCH TRANSFER TYPE
	Disix	[[SIXBIT\% = DATA:#!\] ;ENTER PIP TRANSFER COMMAND
		PUSHJ	P,IMPPTY
		]
;[tcp]	PUSHJ	P,XFRCHK	;WAIT FOR SUCCESSFUL COMPLETION
;[tcp]	  POPJ	P,		;ERROR, MESSAGE ALREADY PRINTED
;[tcp]	EDisix	[CNCUSR,,[SIXBIT\252 T&RANSFER COMPLETED.#!\]]
	jrst	RtrEnd			;[tcp] standard out


ife FtHarv,<	;[96bit] harvard DIRECT does not support /InDir
;   Nlst <PathName>		[96bit]

C.Nlst:	TXO	F,NlsCom	;[96bit] remember we're doing NLST
;	Jrst	C.List		;[96bit] fall into LIST command
>	;end of IFE FtHarv


;   LIST <PATHNAME>

C.LIST:
;[96bit]WSix	[SIXBIT\ASSIGN IMP LPT#!\] ;KLUDGE TO DIRECT OUTPUT FROM
;[96bit]PUSHJ	P,GETRSP	;  HARVARD DIRECT TO AN IMP DEVICE.
;[96bit]  EDisix [PTYFLS,,[SIXBIT\454 N&O &IMP&S AVAILABLE.#!\]]
;[96bit]PUSHJ	P,PTYFLS	;FLUSH "IMPN ASSIGNED" MESSAGE
;[96bit]MOVSI	T1,'LPT'	;LOGICAL DEVICE NAME
	MOVE	T1,[Sixbit \Data\]	;[96bit] normal logical name
	MOVEI	T2,0		;ASCII DATA TYPE
	PUSHJ	P,DoOpen	;OPEN DATA CONNECTION FOR OUTPUT
	  POPJ	P,		;ERROR, MSG ALREADY PRINTED
Ife FTHarv,<	;[96bit] harvard DIRECT doesn't support /InDirect
	TXZE	F,NlsCom	;[96bit] an NLST? (Clear flag if on)
	  SKIPA	T1,[Sixbit \/Indir\]	;[96bit] yes: do indirect
	SETZ	T1,		;[96bit] LIST command: don't do indirect
;[96bit]Disix	[[SIXBIT\DIRECT /L %#!\]
	Disix	[RtrEnd,,[SIXBIT\DIRECT Data:=% %#!\]
		WNAME	T1	;[96bit] give the /I if it's there
		PUSHJ	P,IMPPTY]
>	;end of IFE FtHarv
ifn FtHarv,<	;[96bit] harvard DIRECT is "non-standard"
	Disix	[RtrEnd,,[SIXBIT\DIRECT %/FILE=Data:#!\]
		PUSHJ	P,IMPPTY]
>	;end of IFN FtHarv
;[96bit]PUSHJ	P,XFRCHK	;WAIT FOR COMPLETION OF DATA TRANSFER
;[96bit]  POPJ	P,		;ERROR--MESSAGE ALREADY PRINTED
;[96bit]PUSHJ	P,PTYFLS	;GET RID OF ANY GARBAGE FROM DIRECT
;[96bit]WSix	[SIXBIT\IMP CLOSE LPT:#!\] ;CLOSE DATA CONNECTION
;[96bit]MOVSI	T1,'452'	;ERROR CODE TO USE IF ERROR
;[96bit]PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
;[96bit]  PJRST	CPYRSP		;ERROR, CPY RESPONSE TO USER
;[96bit]EWSix	[SIXBIT\252 T&RANSFER COMPLETED.#!\]
;[96bit]PJRST	PTYFLS		;FLUSH REMAINING PTY OUTPUT
;     MLFL <PPN>

IfDef MlFlCommand,<	;[96bit] if we are supporting Mail File commands
			;	 then define this, else leave undefined
			;	 and let the command macro sort it out.
C.MLFL:	MOVE	T1,[SIXBIT/DATA/];THE LOGICAL NAME WE WANT TO USE
	MOVEI	T2,0		;TRANSFER IN ASCII MODE
	PUSHJ	P,DoOpen	;TRY TO GET IMP
	  PJRST ML.ERR		;FAILED..GIVE UP
	TXO	F,MLFLFG	;SET INSIDE MLFL FLAG
;[96bit]Disix	[[SIXBIT\MAIL /ZVRF/ZXC/TO:%/IDENTI:%/FILE:DATA:#!\]
;[96bit]	PUSHJ	P,IMPPTY
;[96bit]	PUSHJ	P,HSTPRT]
	MlFlCommand		; do the right mail file command
	PUSHJ	P,XFRCHK	;WAIT TIL THINGS FINISH UP
	  PJRST ML.ERR		;SOMETHING DIED ALONG THE WAY
	MOVSI	T1,'051'	;GENERAL FTP COMMENTARY
	LCHF	P1			;GET FIRST CHAR
	PUSHJ	P,CPYRSP	;COPY ALL RESPONSES FROM MAIL
	;[96bit] assume no trouble
	Movei	T2,[SIXBIT/252 MAIL &TRANSFER COMPLETED.#!/]
	TXNE	F,ERRFLG	;ANY ERRORS IN RESPONSES?
	  Movei	T2,[SIXBIT/454 MLFL &FAILED.#!/]  ;[96bit] trouble.
	EWSix	(T2)		;[96bit] give the error message
	TXZ	F,MlFlFg	;[96bit] clear mail flag
;[96bit]TXZE	F,LGAR0M	;DID WE LOGIN AS AR0M?
	TXZE	F,TLogin	;[96bit] want to undo login?
	PJRST	FREOUT		;DO A LOGOUT AND RETURN
	PJRST	PTYFLS		;GET RID OF EXTRA PTY TRASH

ML.ERR:	TXZ	F,MLFLFG
;[96bit]TXZE	F,LGAR0M
	TXZE	F,TLogin		;[96bit] undo login?
	PUSHJ	P,FREOUT
	POPJ	P,

>	; end IfDef MlFlCommand
	SUBTTL	MISCELLANEOUS FTP FUNCTIONS

;   MAIL <PPN>

C.MAIL:
;[96bit]Disix	[[SIXBIT\MAIL /ZVRF/ZXC/TO:%/IDENTI:%/FILE:TTY:#!\]
;[96bit]	PUSHJ	P,IMPPTY
;[96bit]	PUSHJ	P,HSTPRT]
	MailCommand		;[96bit] do the right mail command
;[CFE]	MOVSI	T1,'507'	;A GENERAL ERROR CODE
	MOVSI	T1,'454'	;[CFE] A temporary-failure code.
	TXO	F,MAILFG	;[CFE] Let GETRSP make badness into
				;[CFE]   permanent-failure type codes.
	PUSHJ	P,GETRSP	;SEE HOW IT GOES
;[CFE]	  PJRST	CPYRSP		;NOT WELL
	  PJRST	[TXZ	F,MAILFG	;[CFE] Clear this state first
		 PJRST	CPYRSP]		;NOT WELL
;[CFE]	TXO	F,MAILFG	;TELL COMAND TO COME HERE FOR A WHILE
	EWSix	[SIXBIT\350 E&NTER MAIL, ENDED BY A LINE WITH JUST A '.'#!\]
	PJRST	PTYFLS		;FORGET ANYTHING ELSE MAIL SAID

C.MAIX:	MOVE	T1,CMDPTR	;HERE WHEN A TELNET LINE COMES IN WHILE IN MAIL
	ILDB	T2,T1		;SEE IF IT IS ONLY A .<CR>
	CAIE	T2,"."		;WHICH IS THE MAIL TERMINATION CHARACTER
	JRST	MAIX1		;WELL, NOT YET
	ILDB	T2,T1		;IS THE NEXT A <CR>?
	CAIE	T2,CR
	JRST	MAIX1		;NO, SEND IT ALL OFF TO THE PTY
	FOSEL	PTYOBL		;IT IS. FINISH UP MAIL
	W2CHI	<"Z"-100>B28+LF	;AND GIVE IT THE CTRL-Z IT WANTS
				;+ A LF TO FORCE OUT THE BUFFER
	PUSHJ	P,XFRCK1	;WAIT TILL THINGS FINISH UP
		POPJ	P,	;SOMETHING WENT WRONG
	MOVSI	T1,'051'	;GENERAL RESPONSE CODE
	LCHF	P1		;GET FIRST CHAR
	PUSHJ	P,CPYRSP	;COPY RESPONSES LOOKING FOR ERRORS
	;[96bit] assume no trouble
	Movei	T2,[SIXBIT/256 MAIL &COMPLETED.#!/]
	TXNE	F,ERRFLG	;ANY ERRORS IN RESPONSES?
	  Movei	T2,[SIXBIT/454 MAIL &FAILED.#!/]  ;[96bit] trouble.
	EWSix	(T2)		;[96bit] give the error message
	TXZ	F,MAILFG	;CLEAR THIS
	PJRST	PTYFLS		;THROW OUT ANY GARBAGE

MAIX1:	Disix	[[SIXBIT\%#!\]
		PUSHJ	P,IMPPTY]
	POPJ	P,		;FINISHED THIS LINE, TRY ANOTHER
;   DELE <PATHNAME>

C.DELE:	Disix	[[SIXBIT\DELETE %#!\]
		PUSHJ	P,IMPPTY]
	MOVSI	T1,'501'	;ONLY POSSIBLE ERROR IS SYNTAX ERROR
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR, PRINT MESSAGE
	LCHF	P1		;BACK OVER FIRST CHAR OF RESPONSE
	MOVSI	T1,'050'	;GENERAL FTP COMMENTARY
	PUSHJ	P,CPYRSP	;COPY DELETE RESPONSE TO USER
	TXNN	F,ERRFLG	;WERE THERE ANY ERRORS?
	EDisix	[CPOPJ##,,[SIXBIT\254 D&ELETE COMPLETED.#!\]]
	EDisix	[CPOPJ##,,[SIXBIT\451 D&ELETE UNSUCCESSFUL.#!\]]



;   ALLO <DECIMAL INTEGER>

C.ALLO:	EWSix	[SIXBIT\200 A&LLOCATION NOT REQUIRED ON THIS SYSTEM.#!\]
	POPJ	P,



;   RNFR <PATHNAME>

C.RNFR:	HLLZ	T1,CMDPTR	;GET LH OF CURRENT BYTE PTR
	HRRI	T1,RNFBUF	;BUILD POINTER TO "RENAME FROM" BUFFER
	MOVEM	T1,RNFPTR	;SAVE IT
	HRL	T1,CMDPTR	;COPY "FROM" PATHNAME TO TEMP BUFFER
	BLT	T1,RNFBUF+CMDLEN/5
;[CFE] Also copy character count.
	move	t1,CmdCnt	;[CFE] From CMD buffer
	movem	t1,RnFCnt	;[CFE]  to RNF buffer.
	EDisix	[CPOPJ##,,[SIXBIT\200 RNFR &PATHNAME STORED.#!\]]

;   RNTO <PATHNAME>

C.RNTO:	SKIPN	T1,RNFPTR	;CHECK FOR PRECEDING RNFR
	EDisix	[CPOPJ##,,[SIXBIT\504 RNFR &COMMAND MUST PRECEDE &RNTO& COMMAND.#!\]]
	move	t2,RnFCnt	;[CFE] Also load character count
	Disix	[[SIXBIT\RENAME % = %%%#!\]
		PUSHJ	P,IMPPTY	;COPY NEW PATHNAME TO PTY
		MOVEM	T1,CMDPTR
		movem	t2,CmdCnt	;[CFE] Copy count, also
		PUSHJ	P,IMPPTY]	;NOW OLD PATHNAME
	SETZM	RNFPTR		;CLEAR OLD POINTER
	MOVSI	T1,'501'	;ERROR IN FIRST LINE IS PROBABLY SYNTAX
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR, COPY RESPONSE AND QUIT
	LCHF	P1		;OK, BACKUP OVER FIRST CHAR
	MOVSI	T1,'050'	;FTP COMMENTARY
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO USER
	TXNN	F,ERRFLG	;WERE THERE ANY ERRORS?
	EDisix	[CPOPJ##,,[SIXBIT\253 R&ENAME COMPLETED.#!\]]
	EDisix	[CPOPJ##,,[SIXBIT\451 R&ENAME UNSUCCESSFUL.#!\]]
;   STAT	OR	STAT <PATHNAME>

C.STAT:	PUSHJ	P,SPNOR1	;IGNORE BLANKS
	CAIE	P1,LF		;END OF LINE?
	JRST	STATDR		;NO, GO PROCESS PATHNAME
	MOVSI	T1,'050'
	EDisix	[EXP	SRVMSG
		WSIX	4,T1
		WASC	SYSNAM]
	EDisix	[[SIXBIT\100-C&URRENT PARAMETERS:#∨
    &H&OST: %   &L&ocal &S&OCKET: %   &R&emote &S&OCKET: %#!\]
		PUSHJ	P,HstPrt	;[96bit] print name
		WDEC	LclSkt
		WDEC	RmtSkt]

repeat 0,<	; these are implmeneted
	HLRZ	T1,XFRTYP
	HLRZ	T2,STRTYP
	HLRZ	T3,MODTYP
	EDisix	[[SIXBIT\    B&YTE SIZE: %   &T&YPE: %   &S&TRUCTURE: %   &M&ODE: %#!\]
		WDEC	BYTSIZ
		WCHI	(T1)
		WCHI	(T2)
		WCHI	(T3)]
> ; end of repeat 0

	TXNE	F,LGIFLG	;LOGGED IN?
	EDisix	[[SIXBIT\    S&ERVER JOB LOGGED IN UNDER [%]#!\]
		PUSHJ	P,PPNPRT]
	TXNE	F,USRFLG	;PASSWORD EXPECTED?
	EWSix	[SIXBIT\    P&ASSWORD EXPECTED#!\]
	EWSix	[Sixbit \100 E&nd of status.#!\]	;[96bit]
	POPJ	P,

;HERE TO DO STAT <PATHNAME>, I.E. DIRECTORY LISTING.
STATDR:	TXNE	F,LGIFLG	;LOGGED IN?
	JRST	.+3		;YES, PROCEED
	PUSHJ	P,FRELGI	;NO, ATTEMPT FREE LOGIN
	  POPJ	P,		;FAILED (MSG ALREADY TYPED)
	LCHF	P1		;OK, BACKUP OVER FIRST CHAR OF PATHNAME
	Disix	[[SIXBIT\DIRECT %#!\] ;OUTPUT COMMAND TO PTY
		PUSHJ	P,IMPPTY]
	MOVSI	T1,'501'	;ERROR IS PROBABLY A SYNTAX ERROR
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR--COPY RESPONSE TO USER
	MOVSI	T1,'151'	;DIRECTORY LISTING REPLY
	LCHF	P1		;BACK UP OVER FIRST CHAR
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO USER
	EWSIX	[SIXBIT\200 D&IRECTORY LISTING COMPLETED.#!\]
	POPJ	P,
;   HELP
;[96bit] messages changed slightly to agree with protocol.

C.HELP:	EDisix	[Cpopj##,,HlpMsg
		  Call	HlpLst
		]

; help message.  note the percent sign at the end of the first line.
HlpMsg:	SIXBIT\200-T&HE FOLLOWING &FTP& FUNCTIONS ARE IMPLEMENTED:%#∨
    &O&NLY &ASCII& AND 36-BIT IMAGE TRANSFERS.#∨
    &STAT, LIST, NLST, DELE, RNFR, RNTO& ACCEPT WILDCARD SPECIFICATIONS.#∨
    &N&ONSTANDARD COMMANDS:#∨
      &XCWD  C&HANGE WORKING DIRECTORY.#∨
      &XSRC  C&HANGE DISK SEARCH LIST.#∨
      &XTIM  D&ISABLE INACTIVITY TIMEOUT.#∨
200 &E&nd of &HELP&.#!\

; prints out all the commands which should be printed for help.
; only called from inside EDisix, so the EFile in standard output.
HlpLst:	MOVSI	T1,-COMLEN	;CHECK EACH ONE
	SETZ	T3,		;RESET NUMBER OF ITEMS SO FAR
HELP1:	MOVE	T2,COMDSP(T1)	;GET DISPATCH WORD FOR THIS COMMAND
	TXNN	T2,CM.HLP	;WANT COMMAND LISTED?
	JRST	HELP2		;NO, SKIP IT
	SOJG	T3,.+3		;JUMP IF STILL ROOM ON THE LINE
	WSIX	[SIXBIT\#    !\] ;NO, START ANOTHER
	MOVEI	T3,↑D10		;RESET COUNTER
	WSIX	6,COMTAB(T1)	;LIST THE COMMAND
HELP2:	AOBJN	T1,HELP1	;LOOP FOR REST
Ife $FtpLog,<	;[96bit] tell if we don't allow not logged in access
	WSIX	[SIXBIT	\#    U&SER COMMAND REQUIRED TO ACCESS ANY FILES.\]
>
	Return			; now go back and print the rest.
	SUBTTL	NONSTANDARD FUNCTIONS

;    XTIM

C.XTIM:	HRROS	WATCNT		;DISABLE INACTIVITY TIMEOUT
	PJRST	COMACK		;ACKNOWLEDGE COMMAND


;    XSRC <SETSRC-STYLE SEARCH LIST>

C.XSRC:	WSix	[SIXBIT\R SETSRC#!\] ;CALL THE STANDARD DEC CUSP
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	COMNAK		;ERROR, COMPLAIN
	PUSHJ	P,PTYFLS	;FLUSH PROMPT, HELP MSG, ETC.
	Disix	[[SIXBIT\C %#!\] ;CREATE NEW SEARCH LIST AS SPECIFIED
		PUSHJ	P,IMPPTY]
	PJRST	XCMRSP		;WAIT FOR WINNING OR LOSING RESPONSE


;    XCWD <DIRECTORY>     OR    XCWD [<DIRECTORY>]

C.XCWD:	WSix	[SIXBIT\R SETSRC#!\] ;RUN SETSRC TO DO THE WORK
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	COMNAK		;CAN'T DO SETSRC STUFF
	PUSHJ	P,PTYFLS	;FLUSH RESPONSE
	FISEL	IMPCBL		;GET INPUT FROM IMP AGAIN
	CCHF	P1
	PUSHJ	P,SPNOR		;SKIP BLANKS
	CAIE	P1,"["		;DID USER TYPE SQUARE BRACKETS?
	LCHF	P1		;NO, BACKUP (SINCE IMPPTY DOES RCHF)
	;[96bit] NOTE: do NOT add a close bracket to the following
	;	 line.  it makes "XCWD [342,231]" illegal.
	Disix	[[SIXBIT\CP [%#!\] ;ENTER SETSRC COMMAND
		PUSHJ	P,IMPPTY]
XCMRSP:	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	COMNAK		;LOSES, SAY WHY
	PUSHJ	P,CNCUSR	;WINS, FORCE TO COMMAND LEVEL
				;AND FALL INTO COMACK


;ROUTINE TO REPLY FOR A SUCCESSFUL MISCELLANEOUS COMMAND

C.NoOp:	;[96bit]	No-Op just acknowledges command
COMACK:	EDisix	[CPOPJ##,,[SIXBIT\200 % &COMMAND ACCEPTED.#!\]
		WNAME	CMDNAM]

;ROUTINE TO COMPLAIN ABOUT AN ERROR IN A NONSTANDARD COMMAND

COMNAK:	MOVSI	T1,'507'	;CATCHALL ERROR REPLY CODE
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO USER FROM PTY
	EDisix	[CNCUSR,,[SIXBIT\507 % &COMMAND NOT ACCEPTED.#!\]
		WNAME	CMDNAM]
;    XREP	(REPLAY RECORDED PTY DIALOGUE, FOR DEBUGGING)

C.XREP:	EDisix	[Cpopj##,,[SIXBIT\050-R&EPLAY OF RECORDED &PTY& DIALOGUE:#∨
%∨
050 &E&nd of replay.#∨
200 &R&EPLAY COMPLETED.#!\]
	 Call	Replay			; do the replay
	]

Replay:	SKIPGE	T1,RECPTR	;IS ANYTHING THERE?
	  Return		; no, forget it.
	TXNN	F,WRPFLG	;YES, DOES IT WRAP AROUND?
	MOVE	T1,RECPT0	;NO, START AT BEGINNING OF BUFFER
XREP1:	CAMN	T1,RECPTZ	;AT END?
	MOVE	T1,RECPT0	;YES, GO BACK TO BEGINNING
	ILDB	T2,T1		;GET A CHAR
	WCHI	(T2)		;SEND IT TO IMP
	CAME	T1,RECPTR	;BACK WHERE WE STARTED?
	JRST	XREP1		;NO, CONTINUE
	CAIE	T2,LF		;YES, WERE WE AT EOL?
	W2CHI	CRLF		;NO, START FRESH LINE
	Return			; all done: go back and print the ending
	SUBTTL	SUBROUTINES

;ROUTINE TO OPEN THE SUBJOB'S IMP DATA CONNECTION.
;	MOVE	T1,[SIXBIT IMP LOGICAL DEVICE NAME TO BE USED]
;	MOVE	T2,[TYPE INDEX -- 0=ASCII, 1=IMAGE]
;	PUSHJ	P,DoOpen
;	  ERROR RETURN--MESSAGE ALREADY TYPED
;	OK RETURN

DoOpen:
	EDisix	[[SIXBIT\255 SOCK %#!\] ;STANDARD MESSAGE
		WDEC	LCLSkt]
	Disix	[[SIXBIT\IMP CONNECT %: % /LOCAL:%/Absolute/REMOTE:%#!\]
		WNAME	T1
		Pushj	P,HstNoo	;[96bit] print host number
		WDEC	LCLSKT
		WDEC	RmtSkt
		]
	MOVSI	T1,'454'	;MESSAGE CODE IN CASE ERROR
	PUSHJ	P,GETRSP	;EAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR, COPY MESSAGE TO USER AND QUIT
	PUSHJ	P,PTYFLS	;OK, FLUSH OUTPUT
	JRST	CPOPJ1##		;TAKE GOOD RETURN
;ROUTINE TO WAIT FOR COMPLETION OF A DATA TRANSFER FUNCTION
;	PUSHJ	P,XFRCHK
;	  ERROR--MESSAGE ALREADY PRINTED AND CONNECTION CLOSED
;	OK--NOTHING PRINTED, CONNECTION NOT CLOSED, OUTPUT NOT FLUSHED

XFRCHK:	MOVEI	T1,1		;WAIT ONE SECOND FOR THINGS TO GET STARTED
	SLEEP	T1,
	PUSHJ	P,PTYCHK	;HAS ANYTHING COME BACK FROM THE SUBJOB?
	  EDisix [XFRCK1,,[SIXBIT\250 % &STARTED.#!\]
		WNAME	CMDNAM]
	PUSHJ	P,GETRSP	;YES, SEE WHAT IT WAS
	  JRST	XFRERR		;AN ERROR, GO COMPLAIN
	EDisix	[CPOPJ1##,,[SIXBIT\250 % &STARTED.#!\]
		WNAME	CMDNAM]

;HERE IF NO RESPONSE IN THE FIRST SECOND
XFRCK1:	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  JRST	XFRERR		;ERROR, GO COMPLAIN
	JRST	CPOPJ1##		;OK, SKIP RETURN

;HERE ON ERROR RESPONSE DURING DATA TRANSFER
XFRERR:
	MOVSI	T3,'507'	;if code is 507 don't change to 454
	CAME	T3,T1
	MOVSI	T1,'454'	;CATCHALL ERROR MESSAGE
	PUSHJ	P,CPYRSP	;COPY ERROR MESSAGE TO USER
	PUSHJ	P,CNCUSR	;FORCE TO COMMAND LEVEL
	WSix	[SIXBIT\IMP CLOSE/SELF#!\] ;CLOSE OPEN CONNECTION(S)
	PJRST	PTYFLS		;FLUSH ANYTHING THAT COMES BACK UP
;ROUTINE TO PERFORM A "FREE" FTP LOGIN
;	PUSHJ	P,FRELGI
;	  ERROR--MESSAGE ALREADY PRINTED
;	OK--LGIFLG HAS BEEN SET

FRELGI:
Ife $MLogin ! $FtpLog,<	;[96bit] if no free logins, complain and return
	EDisix [Cpopj,,[SIXBIT\504 USER &COMMAND REQUIRED BEFORE %.#!\]
		WNAME	CMDNAM]
>	;end ife ftfree
Ifn $MLogin ! $FtpLog,<	;[96bit] want free logins of some kind?
	TXZE	F,USRFLG	;LEFTOVER USER NAME?
	PUSHJ	P,CNCUSR	;YES, FLUSH IT
Ifn $MLogin,<	;[96bit] any special mail stuff?
	TXNN	P4,CM.LGM	;WANT FREE LOGIN FOR MLFL
	JRST	FRELG1		;NO
Ifn MailPPn,<	;[96bit] need to chgppn?
	MovX	T1,MailPPn		;[96bit] change the current ppn
	CHGPPN	T1,
	   JFCL
>	;end ifn MailPPn
	HRRZI	T1,MailLogin	;[96bit] set up the proper ppn
	TXO	F,TLogin	;[96bit] remember to log this out
	JRST	FRELG2
FRELG1:
>	;end ifn $Mlogin
Ife $FtpLog,<	;[96bit] if not allowing normal FTPs without USER,
		;	 then complain and return
	EDisix [Cpopj,,[SIXBIT\504 USER &COMMAND REQUIRED BEFORE %.#!\]
		WNAME	CMDNAM]
>
Ifn $FtpLog,<	;[96bit] logging in for ftp?
Ifn FtpPPn,<	;[96bit] want a chgppn for ftp?
	MovX	T1,FtpPPn	;[96bit] get the PPn to change to
	CHGPPN	T1,		;YES, DO IT
	  JFCL			;DON'T CARE IF FAILS
>
	HRRZI	T1,FtpLogin	;[96bit] get name of free account
>	;end ifn $ftplog
FRELG2:	Disix	[[SIXBIT\LOGIN %#!\] ;ATTEMPT TO LOGIN
		WSIX	(T1)]
	PUSHJ	P,CHKLGI	;SEE HOW IT DID
	  PJRST	[		; totally invalid
		 TXZ F,TLogin	;[96bit] not logged in
		 PJRST LGIERF
		]
	  EDisix [CNCUSR,,[SIXBIT\504 USER &COMMAND REQUIRED BEFORE %.#!\]
		  WNAME	CMDNAM]
	PUSHJ	P,SJBPPN	;WE DID, GET SUBJOB PPN
	MOVEM	T1,PRJPRG	;STORE IT
	TXO	F,LGIFLG	;REMEMBER LOGIN SUCCESS
	LCHF	P1		;RETAIN FIRST CHAR OF RESPONSE
	MOVSI	T1,'050'	;CODE FOR GENERAL FTP INFO
	PUSHJ	P,CPYRSP	;COPY LOGIN MESSAGES TO USER
	FISEL	IMPCBL		;POINT TO INPUT FILE BLOCK AGAIN
	JRST	CPOPJ1##		;TAKE SUCCESS RETURN
>	;end Ifn $MLogin ! $FtpLog


;ROUTINES TO HANDLE LOGIN FAILURE AND PRINT MESSAGE
;	PUSHJ	P,LGIERR OR LGIERF
;	ALWAYS RETURN HERE, MESSAGE PRINTED, PTY OUTPUT FLUSHED
;  LGIERR USES CODE 431, LGIERF USES 504.
;[CFE]	LGIERF now uses 436 since it's just a temporary error condition!

LGIERR:	MOVSI	T1,'431'	;ERROR CODE FOR NORMAL LOGIN ATTEMPT
	TXZA	F,USRFLG	;CLEAR USER-NAME-GIVEN FLAG
;[CFE] LGIERF:	MOVSI	T1,'504'	;ERROR CODE FOR FREE LOGIN ATTEMPT
LGIERF:	MOVSI	T1,'436'	;[CFE] ERROR CODE FOR FREE LOGIN ATTEMPT
	RCHF	P1		;GET FIRST CHAR AFTER QUESTION MARK
	CAIE	P1,"("		;ERROR NUMBER IN PARENTHESES?
	JRST	.+4		;NO
	RCHF	P1		;YES, FLUSH LEFT PAREN
	RCHF	P1		;FLUSH ERROR CODE
	JRST	.+2		;CAUSE RIGHT PAREN TO BE FLUSHED
	LCHF	P1		;BACKUP IF DIDN'T SEE "("
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO USER
	PJRST	CNCUSR		;FORCE SUBJOB TO COMMAND LEVEL.
;ROUTINE TO LOG THE SUBJOB OUT.
;	PUSHJ	P,LGOUSR
;	RETURN HERE AFTER SUBJOB LOGGED OUT

LGOUSR:	PUSHJ	P,CNCUSR	;FORCE TO MONITOR LEVEL
	MOVSI	T1,'050'	;TREAT REPLIES AS COMMENTARY
IfDef KjFunc,<	;[96bit] is there a brain damaged logout?
	KjFunc			;[96bit] yes: use it.
>
IfNDef KjFunc,<	;[96bit] no: use k/b
	WSix	[SIXBIT\KJOB /B#!\] ;PRESERVE ANY FILES POSSIBLE
	PJRST	CPYRSP		;COPY RESPONSE TO USER IF HE'S STILL THERE
>

Repeat 0,<	;[96bit] do this with macros now
	HRRZ	T2,BYEDSP(H)	;GET DISPATCH FOR DESIRED LOGOUT PROTOCOL
	JRST	(T2)		;  FOR THIS HOST

KJOB.F:	WSix	[SIXBIT\KJOB /F#!\];CMU- SAVE ALL FILES
	PUSHJ	P,CPYRSP	;COPY THIS
	TXNN	F,ERRFLG	;ERROR (OVER QUOTA)
	POPJ	P,		;NOPE ALL IS GOODNESS
	PUSHJ	P,CNCUSR	;STOP HIM
	WSix	[SIXBIT/CORE 0#!/];FREE ALL HIS CORE
	PJRST	PTYFLS		;AND GO AWAY

KJOB.B:	WSix	[SIXBIT\KJOB /W/B#!\] ;PRESERVE ANY FILES POSSIBLE
	PJRST	CPYRSP		;COPY RESPONSE TO USER IF HE'S STILL THERE
>	;end of repeat 0


;ROUTINE TO SEND CONTROL-C'S TO THE SUBJOB AND FLUSH ALL RESULTING
;   OUTPUT.
;	PUSHJ	P,CNCUSR
;	ALWAYS RETURN HERE

CNCUSR:	FOSEL	PTYOBL		;SELECT INPUT AND OUTPUT PTY
	FISEL	PTYIBL
	W2CHI	3B28+3		;SEND 2 ↑C'S
	WCHI	LF		;MAKE BUFFER BE FORCED OUT
				;FALL INTO PTYFLS


;ROUTINE TO FLUSH ALL PTY OUTPUT UNTIL IT GOES INTO INPUT WAIT.
;	PUSHJ	P,PTYFLS
;	ALWAYS RETURN HERE

PTYFLS:	FISEL	PTYIBL		;SELECT PTY FOR INPUT
PtyFl1:	RCHF	P1		;GET A CHAR
	JUMPN	P1,PtyFl1	;TRY AGAIN IF GOT ANYTHING
	POPJ	P,		;RETURN WHEN NOTHING MORE


;ROUTINE TO FLUSH PTY OUTPUT UNTIL EITHER A LINE FEED IS ENCOUNTERED
;   OR THE SUBJOB GOES INTO TTY INPUT WAIT.
;	PUSHJ	P,PTYF1L
;	ALWAYS RETURN HERE

PTYF1L:	FISEL	PTYIBL		;SELECT PTY FOR INPUT
PtyF11:	RCHF	P1		;GET A CHAR
	CAIE	P1,LF		;LINE FEED?
	JUMPN	P1,PtyF11	;NO, FLUSH IF NOT END OF OUTPUT
	POPJ	P,
;ROUTINE TO WAIT FOR A RESPONSE FROM THE SUBJOB.
;	PUSHJ	P,GETRSP
;	  ERROR--RESPONSE LINE BEGAN WITH "?"
;	OK RETURN, FIRST CHAR OF RESPONSE IN P1
;   GETRSP FLUSHES BLANK LINES WHILE SEARCHING FOR ITS RESPONSE.

GETRSP:	FISEL	PTYIBL		;SELECT PTY INPUT
GETRS1:	RCHF	P1		;GET A CHAR
	JUMPE	P1,CPOPJ1##	;SKIP RETURN IF GOT NONE
	CAIE	P1,CR		;CARRIAGE RETURN?
	CAIN	P1,LF		;LINE FEED?
	JRST	GETRS1		;YES, FLUSH
	CAIE	P1,"?"		;ERROR RESPONSE?
	JRST	CPOPJ1##		;NO, SKIP RETURN
	;[96bit] check for "?%", which we interpret as
	;	 "user not found" type errors: completely fatal.
	TXNN	F,MAILFG!MLFLFG	;inside mail or mlfl?
	POPJ	P,		;no normal error return
	RCHF	P1		;yes, get next char
	CAIN	P1,"%"		;unknown user type error?
	MOVSI	T1,'507'	;yes, special error code
;[CFE, 16 Apr 81] Make sure a legitimate first character gets through.
	CAIE	P1,"%"		;[CFE] Unless a "%",
	  LCHF	P1		;[CFE]  save it for diagnostic msg.
	POPJ	P,


;ROUTINE TO CHECK WHETHER THE SUBJOB HAS BEEN SUCCESSFULLY LOGGED IN
;AFTER THE LOGIN COMMAND WAS SENT TO IT.
;	Disix	[[SIXBIT\LOGIN %#!\]
;		 PUSHJ	P,WHATEVER]
;	PUSHJ	P,CHKLGI
;	  SOMETHING VERY WRONG, LOGIN GAVE ERROR
;	  NEEDS PASSWORD STILL.
;	SUBJOB LOGGED IN; JOBSTS BITS IN T1

CHKLGI:	PUSHJ	P,GETRSP	;GET RESPONSE FROM LOGIN
	  POPJ	P,		;NOT GOOD, LET CALLER HANDLE
	PUSHJ	P,PTYF1L	;IGNORE THIS LINE (JOB #, TTY#, ETC.)
	jumpn	p1,chklgi	; if there are more chars in the buffer,
				; continue to check for errors.

	; now check to see where we stand
CHKLG1:	MOVEI	T1,PTY		;TAKE A LOOK AT PTY STATUS
	JOBSTS	T1,		;TO CHECK LOGGED IN BIT.
	  PUSHJ	P,Idiocy	;DAMN IT, I JUST HAD ONE!
	txne	t1,jb.uoa	; more output available?
	  jrst	ChkLgi		; yes: go back to error checking
;[CFE]	txne	t1,jb.uli	; well, is it logged in?
;[CFE]	  pjrst	cpopj2		; yes: give an excellent return
;[CFE] Wait for logged-in *and* input wait.
	txnn	t1,Jb.ULI	;[CFE] Logged in?
	  jrst	ChkLg2		;[CFE]  No; skip ahead.
	txnn	t1,Jb.UDI	;[CFE] Awaiting input?
	  jrst	ChkLg3		;[CFE]  no; wait for this bit.
CPopj2:	aos	(p)		; Double-skip (excellent) return.
	jrst	CPopj1##
ChkLg2:
;[CFE]	txne	t1,jb.udi	; input wait?
;[CFE]	  pjrst	cpopj1##	; yes: must want a password
;[CFE]	txne	t1,jb.uml	; at monitor level (and NOT logged in!)
;[CFE]	  pushj	p,idiocy	; this situation should be looked at
;[CFE] No, JB.UDI can happen in monitor mode, also.
	txnn	t1,Jb.UDI	;[CFE] Awaiting input?
	  jrst	ChkLg3		;[CFE]  No, wait for another event.
	txne	t1,Jb.UML	;[CFE] Are we in monitor mode?
	  popj	p,		;[CFE] Yes; something went badly wrong.
	jrst	CPopj1##	;[CFE] No; we must await a password.
ChkLg3:	MOVEI	T1,1		;NONE. WAIT AWHILE
	SLEEP	T1,		; FOR LOGIN TO DO ITS THING
	pushj	p,ImpChk	;[CFE] Check this while we wait
	JRST	CHKLG1		;AND LOOK AGAIN


;ROUTINE TO RETURN THE SUBJOB'S PPN
;	PUSHJ 	P,SJBPPN
;	ALWAYS RETURN HERE WITH PPN IN T1

SJBPPN:	MOVEI	T1,PTY		;PTY CHANNEL
	JOBSTS	T1,		;GET CONTROLLED JOB NUMBER
	  PUSHJ	P,Idiocy
	MOVSI	T1,(T1)		;GET PPN FOR THAT JOB
	HRRI	T1,.GTPPN
	GETTAB	T1,
	  PUSHJ	P,Idiocy
	POPJ	P,
;ROUTINE TO COPY A RESPONSE FROM THE PTY TO THE IMP.
;	MOVE	T1,[4-CHARACTER SIXBIT RESPONSE CODE]
;	PUSHJ	P,CPYRSP
;	ALWAYS RETURN HERE

CPYRSP:	FISEL	PTYIBL		;SELECT PTY INPUT
	FOSEL	IMPOBL		;IMP OUTPUT
	TXZ	F,ERRFLG	;CLEAR ERROR FLAG
CPYRS1:	RCHF	P1		;GET A CHAR
	JUMPE	P1,CpyRs4	;RETURN IF NO MORE
	CAIE	P1,CR		;BLANK LINE?
	CAIN	P1,LF
	JRST	CPYRS1		;YES, FLUSH
;[CFE] Flush double-"." after a MAIL command; ignore leading "."s.
	cain	p1,"."		;[CFE] Is it a monitor dot?
	  jrst	CpyRs1		;[CFE]  yes; ignore it.
	CAIN	P1,"?"		;AN ERROR?
	TXO	F,ERRFLG	;YES, REMEMBER IT
	MOVEI	T2,(P1)		;SAVE THE FIRST CHAR
CpyRsX:	RCHF	P1		;GET NEXT CHAR
	JUMPE	P1,CpyRs4	;QUIT IF NONE (CHAR WAS A PROMPT)
	CAIN	P1,4		;CONTROL-D?
	JRST	CpyRsX		;YES (LOGIN HACK ON SOME ERRORS)
	WSIX	4,T1		;OUTPUT MESSAGE CODE
	WCH	T2		;OUTPUT FIRST CHARACTER
	SKIPA			;KEEP RESPNSE CODE FOR ALL LINES
CPYRS2:	RCHF	P1		;GET A CHAR
	JUMPE	P1,CPYRS3	;JUMP IF ENDED IN MIDDLE OF LINE
	WCH	P1		;OUTPUT CHAR TO IMP
	CAIE	P1,LF		;END OF LINE?
	JRST	CPYRS2		;NO, KEEP COPYING
	JRST	CPYRS1		;YES, START NEW LINE

;HERE IF ENDED IN MIDDLE OF LINE (SHOULDNT)
CPYRS3:	W2CHI	CRLF		;CAUSE LINE TO GO OUT TO IMP ANYWAY
CpyRs4:	FoSel	PtyObl		; return to pty output.
	POPJ	P,


;ROUTINE TO COPY A LINE OF TEXT FROM THE IMP TO THE PTY.
;   THE CRLF AT THE END IS NOT INCLUDED
;	PUSHJ	P,IMPPTY
;	ALWAYS RETURN HERE

IMPPTY:	FISEL	IMPCBL		;SELECT COMMAND BUFFER INPUT
	FOSEL	PTYOBL		;SELECT PTY OUTPUT
IMPPT1:	RCHF	P1		;GET A CHAR
	CAIE	P1,CR		;RETURN OR LINEFEED?
	CAIN	P1,LF
	POPJ	P,		;YES, DONE
	WCH	P1		;NO, SEND TO PTY
	JRST	IMPPT1		;BACK FOR MORE
;ROUTINE TO INPUT A DECIMAL NUMBER FROM THE CURRENT INPUT DEVICE
;   AND RETURN IT IN T1.
;	PUSHJ	P,GETDEC
;	  ERROR--FIRST CHAR NOT A DIGIT
;	OK--NUMBER IN T1

GETDEC:	PUSHJ	P,SPNOR1	;GET FIRST CHAR AND IGNORE SPACES
	TXNN	P2,DIGIT	;IS FIRST CHAR A DIGIT?
	POPJ	P,		;NO--ERROR
	SETZ	T1,		;YES, INITIALIZE NUMBER
GETDE1:	IMULI	T1,↑D10		;ACCUMULATE DIGIT
	ADDI	T1,-"0"(P1)
	RCHF	P1		;GET NEXT
	TRNE	P2,DIGIT	;ALSO A DIGIT?
	JRST	GETDE1		;YES, USE IT
	PUSHJ	P,SPNOR		;NO, IGNORE TRAILING BLANKS
	JRST	CPOPJ1##		;SKIP RETURN


;ROUTINE TO IGNORE BLANKS
;	PUSHJ	P,SPNOR		;USES CURRENT P1
;	PUSHJ	P,SPNOR1	;FETCHES  NEW CHAR BEFORE TESTING

SPNOR1:	RCHF	P1		;FETCH A CHARACTER
SPNOR:	CAIE	P1," "		;BLANK?
	CAIN	P1,CR		;CARRIAGE RETURN (WHICH WE IGNORE)
	JRST	SPNOR1		;YES, FLUSH IT
	POPJ	P,		;NO, RETURN


;ROUTINE TO CHECK FOR PTY OUTPUT
;	PUSHJ	P,PTYCHK
;	  NO OUTPUT AVAILABLE
;	OUTPUT IS AVAILABLE
;   T1 CONTAINS JOBSTS BITS ON EITHER RETURN AND IS THE ONLY AC CLOBBERED

PTYCHK:	MOVE	T1,PTSPNT	;ALSO, SEE IF ANYTHING BUFFERED (NORMALLY WON'T BE)
	CAME	T1,PTRPNT	;MEANING RETRIEVE AND STORE POINTERS ARE DIFFERENT
	JRST	CPOPJ1##		;YES, SKIP RETURN

;ROUTINE TO SEE IF PTY BUFFERS HAVE DATA TO READ IN
PTBCHK:	MOVEI	T1,PTY		;SET PTY CHANNEL
	JOBSTS	T1,		;CHECK STATE OF SUBJOB
	  PUSHJ	P,Idiocy		;HMMM...
	TXNE	T1,JB.UOA	;SUBJOB OUTPUT AVAILABLE?
	AOS	(P)		;THEY ARE...DATA
	POPJ	P,		;NOPE, PTY QUIET
;ROUTINE TO BUFFER PTY OUTPUT SO WE CAN SEND IT SOME DATA

PTYSAV:	PUSH	P,U2		;SAVE CURRENT IO BLOCK
	MOVEI	U2,PTYIBL	;AND POINT TO PTY
PTYS1:	PUSHJ	P,PTYBUF	;GET A CHARACTER FROM PTY
	JUMPE	U1,PTYS2	;0 SAYS END
	SOSLE	PTSCNT		;ROOM TO SAVE THIS ONE?
	IDPB	U1,PTSPNT	;YEP, HE LUCKS OUT
	JRST	PTYS1		;AND TRY FOR ANOTHER, OVERFLOW WILL BE LOST

PTYS2:	POP	P,U2		;RESTORE
	POPJ	P,		;AND RETURN


;ROUTINE TO DO THE RCH OPERATION FOR THE PTY.

PTYRCH:	MOVE	U3,PTRPNT	;PICKUP PTY RETRIEVAL POINTER
	CAMN	U3,PTSPNT	;IS IT THE SAME AS THE STUFF POINTER?
	JRST	PTYBUF		;YES, THEREFORE NO DATA SAVED TO READ, GET FROM BUFFER
	ILDB	U1,U3		;GET NEXT CHAR TO PROCESS
	CAME	U3,PTSPNT	;NOW ARE WE EQUAL?
	JRST	[MOVEM	U3,PTRPNT;NO, SAVE POINTER FOR NEXT TIME
		 POPJ	P,]
	MOVE	U3,[PTYRSH,,PTYRSL];SAME, REINITIALIZE AREA
	BLT	U3,PTYRSE-1	;FOR THE NEXT DATA WE HAVE TO BUFFER
	POPJ	P,		;MEANWHILE, LET THE LAST SAVED CHAR BE PROCESSED

PTYBUF:;ROUTINE TO READ NEXT CHARACTER FROM PTY BUFFERS

	SKIPLE	FILCTR(U2)	;IS THERE ANY BUFFERED DATA?
	JRST	PTYRC1		;YES, GET IT NOW
	MOVE	U1,T1		;NO, SAVE T1
	PUSHJ	P,PTBCHK	;SEE IF PTY HAS ANY MORE OUTPUT DATA
	  JRST	PTYRC2		;IT DOESN'T
	MOVE	T1,U1		;IT DOES.  RESTORE T1 AND PROCESS IT

;HERE WHEN DATA IS AVAILABLE
PTYRC1:	PUSHJ	P,I1BYTE##	;CALL STANDARD BYTE ROUTINE
	JUMPE	U1,PTYBUF	;FLUSH NULLS
	PJRST	RECPUT		;PRINT AND/OR RECORD THE CHAR

;HERE WHEN NO DATA IS AVAILABLE
PTYRC2:	EXCH	U1,T1		;RESTORE T1, PUT JOBSTS BITS IN U1
	TXNE	U1,JB.UDI	;SUBJOB WAITING FOR INPUT?
	TDZA	U1,U1		;YES
	MOVEI	U1,1		;NO, SET SLEEP TIME
	JUMPE	U1,CPOPJ##	;RETURN WITH NULL IF NO MORE OUTPUT
	SLEEP	U1,		;SLEEP ONE SECOND
	PUSHJ	P,IMPCHK	;MAKE SURE TELNET CONNECTION STILL OPEN
	JRST	PTYBUF		;TRY AGAIN
;ROUTINE TO DO WCH OPERATION FOR IMP AND PTY, WHICH WANT TO BREAK
;   ON END-OF-LINE.

IMPWCH:	TXNN	F,OPNFLG	;TELNET CONNECTION OPEN?
	POPJ	P,		;NO, FLUSH IMP OUTPUT
PTYWCH:	PUSHJ	P,O1BYTE##	;CALL STANDARD BYTE OUTPUT ROUTINE
	CAIN	U2,PTYOBL	;PTY OUTPUT?
	PUSHJ	P,RECPUT	;YES, PRINT AND/OR RECORD THE CHAR
	MOVEI	U3,(U1)	;COPY CHARACTER JUST OUTPUT
	ANDI	U3,177		;7 BITS ONLY
	CAIE	U3,LF		;REACHED END OF LINE?
	POPJ	P,		;NO
	CAIE	U2,PTYOBL	;GOING OUT TO PTY?
	JRST	PTYW2		;NO, CAN DO OUTPUT
PTYW1:	MOVEI	U3,PTY		;LET'S SEE IF PTY WANTS DATA
	JOBSTS	U3,
	  JRST	PTYW2		;FAILED? SHOULDN'T HAVE
	TXNE	U3,JB.UOA	;ANY OUTPUT FROM PTY THAT WE MUST STORE FIRST?
	JRST	[PUSHJ P,PTYSAV	;YES, GO BUFFER EVERYTHING IN SIGHT
		 JRST	PTYW1]	;AND SEE IF WE CAN OUTPUT NOW
	TXNE	U3,JB.UDI	;OKAY TO OUTPUT TO?
	JRST	PTYW2		;YES, DO SO
	MOVX	U3,HB.RWJ!HB.RPT!↑D1000;WAIT FOR PTY ACTIVITY
	HIBER	U3,		;DO SO
	  JRST	[MOVEI	U3,1	;FAILED (10/40) SLEEP A SECOND
		 SLEEP	U3,
		 pushj	p,ImpChk ;[CFE] Check IMP connection
		 JRST	PTYW1]	;AND TRY AGAIN
	pushj	p,ImpChk	;[CFE] Ensure connection still there
	JRST	PTYW1		;TRY AGAIN FROM HIBERNATE

PTYW2:	PUSHJ	P,UXCT2##	;YES, CAUSE OUTPUT TO BE SENT
	  OUT
	  POPJ	P,		;OK
	MOVE	U1,FILER2(U2)	;ERROR, TAKE ERROR DISPATCH
	PJRST	UERXIT##


;ROUTINE TO MONITOR AND/OR RECORD CHARACTER IN U1 FOR LATER PLAYBACK.
;	MOVE	U1,[ASCII CHARACTER]
;	PUSHJ	P,RECPUT
;	ALWAYS RETURN HERE, ALL AC'S PRESERVED

RECPUT:	TXNE	F,SLGFLG	;MONITORING?
	OUTCHR	U1		;YES, PRINT THE CHARACTER
	EXCH	U2,RECPTR	;GET CURRENT RECORDING POINTER
	CAME	U2,RECPTZ	;AT END OF BUFFER?
	JRST	.+3		;NO
	TXO	F,WRPFLG	;YES, REMEMBER WE WRAPPED AROUND
	MOVE	U2,RECPT0	;RESET POINTER TO START
	IDPB	U1,U2		;STORE CHAR IN BUFFER
	EXCH	U2,RECPTR	;RESTORE U2 AND STORE NEW POINTER
	POPJ	P,		;RETURN

RECPTZ:	POINT	7,RECBUF+RECSIZ-1,34	;POINTER TO LAST CHAR OF BUFFER
;ROUTINE TO DO THE RCH OPERATION FROM THE IN-CORE IMP BUFFER.

RCHICB:
;[CFE] Provide overflow-safe character processing: obey a count of
;[CFE]  the number of characters saved in the buffer.  Return LFs
;[CFE]  when we're at end of buffer.
	sosge	CmdCnt		;[CFE] Decr and test count
	  jrst	[movei	u1,12	;[CFE] Out of chars!  Return a LF.
		 popj	p,]	;[CFE]
	ILDB	U1,CMDPTR	;GET A CHAR
	CAIL	U1,"A"+40	;LOWER CASE?
	CAILE	U1,"Z"+40
	POPJ	P,		;NO
	TXNN	F,MAILFG	;AND NOT MAIL?
	SUBI	U1,40		;YES, MAKE UPPER
	POPJ	P,


Repeat 0,<	; remove these, and their UUOs (SixImp, SixPty,
		; DSxPty, DSxImp), and replace them with error
		; channel for imp output, normal output for pty output

;VARIOUS SPECIAL UUO HANDLERS

UDSXPT::MOVEI	U2,PTYOBL	;DISIX OPERATION TO PTY
	JRST	.+2

UDSXIM::MOVEI	U2,IMPOBL	;DISIX OPERATION TO IMP
	MOVEM	U2,OFILE##	;STORE CORRECT POINTER TO FILE BLOCK
	PJRST	UDISIX##

USIXPT::MOVEI	U2,PTYOBL	;WSIX OPERATION TO PTY
	JRST	.+2

USIXIM::MOVEI	U2,IMPOBL	;WSIX OPERATION TO IMP
	MOVEM	U2,OFILE##	;STORE CORRECT FILE BLOCK POINTER
	SETZ	U3,		;ONLY INDEFINITE WSIX ALLOWED!
	PJRST	UWSIX##		;DO OPERATION

>;	end of Repeat 0


;ROUTINE TO HANDLE IMPOSSIBLE ERRORS

Idiocy:	SOS	T1,(P)		;GET ERROR ADDRESS
	EDisix	[C.BYE,,[SIXBIT\435 A&N IMPOSSIBLE ERROR HAS OCCURRED AT LOCATION %#!\]
		WOCTI	(T1)]
;ROUTINE TO MAKE SURE THE TELNET CONNECTION IS STILL OPEN.
;	PUSHJ	P,IMPCHK
;	RETURN HERE IF STILL OPEN
;   INITIATES "BYE" COMMAND IF CONNECTION HAS CLOSED
;   NO AC'S CLOBBERED

IMPCHK:	TXNN	F,OPNFLG	;DO WE THINK IT'S OPEN NOW?
	POPJ	P,		;NO, JUST FLUSHING JOB OR SOMETHING
	PUSHJ	P,SAVE1##	;SAVE P1
	MOVEI	P1,CONBLK	;DO STATUS OPERATION
	IMPUUO	P1,
	  JRST	ImpEro		;CONNECTION MUST HAVE GONE AWAY
	LDB	P1,[POINT 6,.IBSTT+CONBLK,35] ;GET STATE
	CAIN	P1,.ISEst	;OPEN?
	  POPJ	P,		;YES, RETURN
;HERE ON IMP ERROR (PROBABLY CONNECTION CLOSED)
ImpEro:	TXZ	F,OPNFLG	;CLEAR IMP OPEN FLAG
	JRST	C.BYE		;FORCE A BYE COMMAND


;HERE ON ERROR FROM THE PTY. TELL USER WHAT HAPPENED, THEN CLOSE
PTYERR:	pushj	p,ImpChk	;[CFE] Check IMP before write, also.
	EDisix	[C.BYE,,[SIXBIT\435 %#!\]
		 ERROUT	PTYOBL]	;REPORT PTY ERROR AND BREAK CONNECTION


;ROUTINE TO PRINT C(PRJPRG) AS REGULAR PPN OR CMUPPN
;	PUSHJ	P,PPNPRT
;	ALWAYS RETURN HERE

PPNPRT:	WPPN	PRJPRG		;PRINT PPN THE REGULAR WAY
	POPJ	P,


;ROUTINE TO PRINT THE NAME OR NUMBER OF THE FOREIGN HOST
; uses currently selected output, which will be the IMP if called
; from "inside" a EDisix.
;	PUSHJ	P,HSTPRT
;	ALWAYS RETURN HERE

HSTPRT:
;[96bit]SKIPE	SXBHST		;DO WE KNOW WHO HE IS?
;[96bit]DISIX	[CPOPJ##,,[SIXBIT\%-%!\]
;[96bit]	WNAME	SXBHST
;[96bit]	WNAME	SXBHST+1]
;[96bit]WDEC	HSTADR		;NO, JUST PRINT IN DECIMAL
	Skipg	HsName		;[96bit] know the name?
	  Jrst	HstNoo		;[96bit] no: print the number
	WASC	@HsName		;[96bit] print the name
	Popj	p,		;[96bit] and return

HstNoo:	;[96bit] subroutine to print host number in new format
	Save	T1		;[96bit] save T1
	LDB	T1,HstPnt	;[96bit] get host number
	WDEC	T1		;[96bit] and print it
	WCHI	"."		;[96bit] separating dot
	LDB	T1,SitPnt	;[96bit] get site number
	WDEC	T1		;[96bit] and print it
	WCHI	"."		;[96bit] separating dot
	LDB	T1,NetPnt	;[96bit] and net number
	WDEC	T1		;[96bit] and print it
	Jrst	Tpopj		;[96bit] restore T1 and return

HstPnt:	Pointr	(HstAdr,Ih.Hst)		;[96bit] pointer to host number
SitPnt:	Pointr	(HstAdr,Ih.Imp)		;[96bit] pointer to net number
NetPnt:	Pointr	(HstAdr,Ih.Net)		;[96bit] to network number

;[96bit] subroutine to set a new host address.  checks HstTmp:
;	 if non-zero, moves value into HstAdr, and looks up the
;	 name and puts it in HsName.  if can't find name, HsName
;	 gets -1.
;NOTE: this routine CANNOT be called from withing a LUUO, like
;      in the instruction list for a EDisix, for example.
SetNam:	Push	P,T1		;[96bit] save a reg
	Skipn	T1,HstTmp	;[96bit] new address?
	  Jrst	Tpopj		;[96bit] no: just return
	Movem	T1,HstAdr	;[96bit] save new address
	Clearm	HstTmp		;[96bit] if it's new, forget newness.
	Setom	HsName		;[96bit] assume we're going to fail
	Push	P,T2		;[96bit] save reg from nasty HstNum
	PUSHJ	P,HstNum##	;FIND OUT WHAT IT'S NAME IS
	  Jfcl			; couldn't get tables.
	  Jrst	T2Popj		; couldn't find entry.  flag is set
	hrrzm	T1,HsName	; remember
T2Popj:	Pop	P,T2		;[96bit] restore T2
TPopj:	Pop	P,T1		;[96bit] restore T1
	Popj	P,		;[96bit] return
	SUBTTL	INITIAL FILE BLOCKS

	XALL

;ICP OUTPUT
ICPBLH:	FILE	IMP,O,ICPBLK,<DEV(ICP),STAT(6)>

;IMP INPUT OVER TELNET CONNECTION
IMPIBH:	FILE	IMP,I,IMPIBL,<DEV(TTY),STAT(.IOASC),OPEN(BYEFR2)
		,INPUT(ImpEro),EOF(ImpEro),OTHER(IMPOBL)>

;IMP OUTPUT OVER TELNET CONNECTION
IMPOBH:	FILE	IMP,O,IMPOBL,<DEV(FTPSRV),STAT(.IOASC),OPEN(BYEFR3)
		,OUTPUT(ImpEro),OTHER(IMPIBL),<INST(<PUSHJ P,IMPWCH>)>>
;PTY INPUT (SUBJOB'S OUTPUT)
PTYIBH:	FILE	PTY,I,PTYIBL,<DEV(PTY),STAT(.IOASC),OPEN(PTYTRY)
		,INPUT(PTYERR),EOF(PTYERR),OTHER(PTYOBL)
		,<INST(<PUSHJ P,PTYRCH>)>>

;PTY OUTPUT (SUBJOB'S INPUT)
PTYOBH:	FILE	PTY,O,PTYOBL,<DEV(PTY),STAT(.IOASC),OPEN(PTYTRY)
		,OUTPUT(PTYERR),OTHER(PTYIBL),<INST(<PUSHJ P,PTYWCH>)>>

;INPUT FROM IMP COMMAND BUFFER
IMPCBH:	PFILE	IMPCBL,<PUSHJ P,RCHICB>
	SUBTTL	LOW-SEGMENT INITIALIZATION DATA

FILLH:

; CONBLK (TELNET CONNECTION BLOCK)
	SIXBIT	\FTPSRV\
	0
	EXP	TLNSKT
	0			;[96bit]
	0

;DEFAULT FTP TRANSFER PARAMETERS
	EXP	↑D8		;BYTE SIZE
	"A" ,,	0		;TRANSFER TYPE (ASCII)
	"F" ,,	0		;STRUCTURE (FILE)
	"S" ,,	0		;MODE (STREAM)

;MISCELLANEOUS
RECPT0:	POINT	7,RECBUF	;POINTER TO FIRST CHAR -1 OF PTY DIALOGUE
				;  RECORDING BUFFER
PTYRSH:				;ADDRESS OF DATA TO REINIT PTY SAVE AREA
	POINT	7,PTYHID	;FIRST-1 CHAR OF BUFFER
	POINT	7,PTYHID
	RECSIZ*5		;# OF BYTES WE CAN STORE
	SUBTTL	OTHER TABLES AND STUFF

;SIGNON STRING

DEFINE XX(V,U,E,W) <
IFE W,<
SRVMSG:	SIXBIT	\%% FTP S&ERVER& V'U(E)#!\
>
IFN W,<
SRVMSG:	SIXBIT	\%% FTP S&ERVER& V'U(E)-W#!\
>>
	VERSTR

;DISPATCH TABLES FOR HOST-DEPENDENT HANDLING

MailCm:	MailCommand		;[96bit] monitor command for mailing

repeat 0,<	;[96bit] forget the tables
HSTTAB:				;HOST NUMBER IN LH, FREE ACCOUNT STRING IN RH

FREACT:	↑D9	,, [SIXBIT\62,"#!\]
	↑D14	,, [SIXBIT\N900AR00!\]
	↑D78	,, [SIXBIT\N900AR00!\]
	↑D142	,, [SIXBIT\N900AR00!\]

	NHOSTS==.-HSTTAB	;NUMBER OF HOSTS IN TABLE

PPNCHG:	0			;PPN TO CHANGE TO WHEN DOING FREE LOGIN
	33125	,, 13750	; N900AR00 (CMUPPN)
	33125	,, 13750
	33125	,, 13750

BYEDSP:	0	,, KJOB.B	;RH IS DISPATCH FOR BYE HANDLING
	0	,, KJOB.F
	0	,, KJOB.F
	0	,, KJOB.F
>
	SUBTTL	LOW SEGMENT
	RELOC	0

ZEROL:		;BEGINNING OF AREA TO ZERO DURING INITIALIZATION

PDL:	BLOCK	PDLSIZ		;STACK
PRJPRG:	BLOCK	1		;PPN OF SUBJOB WHILE LOGGED IN
HSTADR:	BLOCK	1		;HOST TO USE IN DATA TRANSFERS
HstTmp:	Block	1		; place to put a potential new host adr.
HsName:	block	1		; pointer to asciz string of host name
RmtSkt:	BLOCK	1		;REMOTE SOCKET FOR data OPERATIONs
LclSkt:	block	1		; our socket number for data connections
SYSNAM:	BLOCK	5		;LOCAL MONITOR NAME GETS PUT HERE
CMDBUF:	BLOCK	CMDLEN/5+1	;INPUT FTP COMMAND BUFFER
CMDPTR:	BLOCK	1		;POINTER INTO CMDBUF
CmdCnt:	block	1		;[CFE] Count of chars in CmdBuf
RNFBUF:	BLOCK	CMDLEN/5+1	;AREA TO SAVE "RNFR" PATHNAME UNTIL "RNTO"
RNFPTR:	BLOCK	1		;POINTER INTO RNFBUF
RnFCnt:	block	1		;[CFE] Count of chars in RnFBuf
CMDNAM:	BLOCK	1		;NAME OF FTP COMMAND BEING EXECUTED
WATCNT:	BLOCK	1		; # SECONDS WAITED FOR USER TO DO SOMETHING
LHOSTP:	BLOCK	.IBSIZ		;LOCAL HOST PARAMETERS
RECBUF:	BLOCK	RECSIZ		;REGION FOR RECORDING PTY DIALOGUE
PTYHID:	BLOCK	RECSIZ		;REGION FOR SAVING PTY OUTPUT

ICPBLK:				;FILE BLOCK FOR DOING ICP
IMPIBL:	BLOCK	FBSIZE		;IMP TELNET INPUT BLOCK
IMPOBL:	BLOCK	FBSIZE		;IMP TELNET OUTPUT BLOCK
PTYIBL:	BLOCK	FBSIZE		;PTY INPUT (SUBJOB OUTPUT) BLOCK
PTYOBL:	BLOCK	FBSIZE		;PTY OUTPUT (SUBJOB INPUT) BLOCK
IMPCBL:	BLOCK	PBSIZE		;FTP COMMAND PSEUDO-FILE BLOCK

ZEREND:		;END OF AREA TO ZERO DURING INITIALIZATION
FILLL:		;BEGINNING OF AREA TO FILL WITH NONZERO DATA

CONBLK:	BLOCK	.IBSIZ		;TELNET CONNECTION BLOCK

BYTSIZ:	BLOCK	1		;DATA CONNECTION BYTE SIZE
XFRTYP:	BLOCK	1		;DATA TRANSFER TYPE
STRTYP:	BLOCK	1		;DATA TRANSFER STRUCTURE
MODTYP:	BLOCK	1		;DATA TRANSFER MODE

RECPTR:	BLOCK	1		;BYTE POINTER FOR RECORDING PTY DIALOGUE
PTYRSL:				;ADDR TO BLT TO TO REINIT PTY SAVE REGION
PTSPNT:	BLOCK	1		;POINTER FOR STUFFING CHARACTERS
PTRPNT:	BLOCK	1		;POINTER FOR PICKING UP CHARACTERS
PTSCNT:	BLOCK	1		;# OF CHARS LEFT TO FILL IN BUFFER
PTYRSE:				;ADDR+1 TO FINISH REINIT

FLLEND:		;END OF AREA TO SETUP DURING INITIALIZATION

	RELOC
	END	FTPSRV